Bump to v6.0.0 (#1329)

* Also update BACKERS.md

.circleci/config.yml

@@ -66,18 +66,23 @@ jobs:
       - restore_cache:
           keys:
           - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install ncat
+          command: |
+            # utility needed to test socket connection with curl <  7.40
+            sudo apt-get install nmap
       - run:
           name: install stack & dependencies
           command: |
-            curl -L https://github.com/commercialhaskell/stack/releases/download/v1.1.2/stack-1.1.2-linux-x86_64.tar.gz | tar zx -C /tmp
-            sudo mv /tmp/stack-1.1.2-linux-x86_64/stack /usr/bin
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v1.9.3/stack-1.9.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-1.9.3-linux-x86_64/stack /usr/bin
             sudo apt-get update
             sudo apt-get install -y libgmp-dev
             sudo apt-get install -y --only-upgrade binutils
             sudo apt-get install -y postgresql-client
             stack setup
             rm -rf $(stack path --dist-dir) $(stack path --local-install-root)
-            stack install hlint packdeps cabal-install
+            stack install hlint stylish-haskell
       - run:
           name: build src and tests
           command: |
@@ -92,14 +97,8 @@ jobs:
           name: run linter
           command: git ls-files | grep '\.l\?hs$' | xargs stack exec -- hlint -X QuasiQuotes -X NoPatternSynonyms "$@"
       - run:
-          name: extra checks
-          command: |
-            stack exec -- cabal update
-            stack exec --no-ghc-package-path -- cabal install --only-d --dry-run
-            stack exec -- packdeps *.cabal || true
-            stack exec -- cabal check
-            stack haddock --no-haddock-deps
-            stack sdist
+          name: run styler
+          command: git ls-files | grep '\.l\?hs$' | xargs stack exec -- stylish-haskell -i && git diff-index --exit-code HEAD --
       - save_cache:
           paths:
             - "~/.stack"
@@ -123,8 +122,8 @@ jobs:
       - run:
           name: install stack & dependencies
           command: |
-            curl -L https://github.com/commercialhaskell/stack/releases/download/v1.1.2/stack-1.1.2-linux-x86_64.tar.gz | tar zx -C /tmp
-            sudo mv /tmp/stack-1.1.2-linux-x86_64/stack /usr/bin
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v1.9.3/stack-1.9.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-1.9.3-linux-x86_64/stack /usr/bin
             sudo apt-get update
             sudo apt-get install -y libgmp-dev
             sudo apt-get install -y postgresql-client
@@ -155,8 +154,40 @@ jobs:
       - run:
           name: install stack & dependencies
           command: |
-            curl -L https://github.com/commercialhaskell/stack/releases/download/v1.1.2/stack-1.1.2-linux-x86_64.tar.gz | tar zx -C /tmp
-            sudo mv /tmp/stack-1.1.2-linux-x86_64/stack /usr/bin
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v1.9.3/stack-1.9.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-1.9.3-linux-x86_64/stack /usr/bin
+            sudo apt-get update
+            sudo apt-get install -y libgmp-dev
+            sudo apt-get install -y postgresql-client
+            stack setup
+      - run:
+          name: build src and tests
+          command: |
+            stack build --fast -j1
+            stack build --fast --test --no-run-tests
+      - run:
+          name: run tests
+          command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test
+
+  build-test-11:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:11
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
+          command: |
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v1.9.3/stack-1.9.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-1.9.3-linux-x86_64/stack /usr/bin
             sudo apt-get update
             sudo apt-get install -y libgmp-dev
             sudo apt-get install -y postgresql-client
@@ -188,8 +219,8 @@ jobs:
       - run:
           name: install stack & dependencies
           command: |
-            curl -L https://github.com/commercialhaskell/stack/releases/download/v1.1.2/stack-1.1.2-linux-x86_64.tar.gz | tar zx -C /tmp
-            sudo mv /tmp/stack-1.1.2-linux-x86_64/stack /usr/bin
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v1.9.3/stack-1.9.3-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-1.9.3-linux-x86_64/stack /usr/bin
             sudo apt-get update
             sudo apt-get install -y libgmp-dev
             sudo apt-get install -y postgresql-client
@@ -206,6 +237,7 @@ jobs:
             psql "postgres:///postgrest_test" -f test/fixtures/roles.sql
             psql "postgres:///postgrest_test" -f test/fixtures/schema.sql
             psql "postgres:///postgrest_test" -f test/fixtures/jwt.sql
+            psql "postgres:///postgrest_test" -f test/fixtures/jsonschema.sql
             psql "postgres:///postgrest_test" -f test/fixtures/privileges.sql
             test/memory-tests.sh
       - save_cache:
@@ -268,6 +300,10 @@ workflows:
           filters:
             tags:
               only: /v[0-9]+(\.[0-9]+)*/
+      - build-test-11:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
       - build-prof-test:
           filters:
             tags:
@@ -277,6 +313,7 @@ workflows:
             - build-test-9.4
             - build-test-9.6
             - build-test-10
+            - build-test-11
             - build-prof-test
           filters:
             tags:
@@ -288,6 +325,7 @@ workflows:
             - build-test-9.4
             - build-test-9.6
             - build-test-10
+            - build-test-11
             - build-prof-test
           filters:
             tags:
@@ -299,6 +337,7 @@ workflows:
             - build-test-9.4
             - build-test-9.6
             - build-test-10
+            - build-test-11
             - build-prof-test
           filters:
             tags:
@@ -310,6 +349,7 @@ workflows:
             - build-test-9.4
             - build-test-9.6
             - build-test-10
+            - build-test-11
             - build-prof-test
           filters:
             tags:

.github/CONTRIBUTING.md

@@ -32,7 +32,7 @@ your contributions.
   then [find your logs](http://blog.endpoint.com/2014/11/dear-postgresql-where-are-my-logs.html).
 
 * If your database schema has changed while the PostgREST server is running,
-  send the server a `SIGHUP` signal or restart it to ensure the schema cache
+  [send the server a `SIGUSR1` signal](http://postgrest.org/en/v5.2/admin.html#schema-reloading) or restart it to ensure the schema cache
   is not stale. This sometimes fixes apparent bugs.
 
 ## Code

.stylish-haskell.yaml

@@ -39,9 +39,9 @@ steps:
       # - none: Do not perform any alignment.
       #
       # Default: global.
-      align: global
+      align: group
 
-      # Folowing options affect only import list alignment.
+      # The following options affect only import list alignment.
       #
       # List align has following options:
       #
@@ -64,6 +64,25 @@ steps:
       # Default: after_alias
       list_align: after_alias
 
+      # Right-pad the module names to align imports in a group:
+      #
+      # - true: a little more readable
+      #
+      #   > import qualified Data.List       as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #
+      # - false: diff-safe
+      #
+      #   > import qualified Data.List as List (concat, foldl, foldr, init,
+      #   >                                     last, length)
+      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #
+      # Default: true
+      pad_module_names: true
+
       # Long list align style takes effect when import is too long. This is
       # determined by 'columns' setting.
       #
@@ -75,7 +94,7 @@ steps:
       #   short enough to fit to single line. Otherwise it'll be multiline.
       #
       # - multiline: One line per import list entry.
-      #   Type with contructor list acts like single import.
+      #   Type with constructor list acts like single import.
       #
       #   > import qualified Data.Map as M
       #   >     ( empty
@@ -109,7 +128,7 @@ steps:
       #   Useful for 'file' and 'group' align settings.
       list_padding: 4
 
-      # Separate lists option affects formating of import list for type
+      # Separate lists option affects formatting of import list for type
       # or class. The only difference is single space between type and list
       # of constructors, selectors and class functions.
       #
@@ -126,6 +145,22 @@ steps:
       # Default: true
       separate_lists: true
 
+      # Space surround option affects formatting of import lists on a single
+      # line. The only difference is single space after the initial
+      # parenthesis and a single space before the terminal parenthesis.
+      #
+      # - true: There is single space associated with the enclosing
+      #   parenthesis.
+      #
+      #   > import Data.Foo ( foo )
+      #
+      # - false: There is no space associated with the enclosing parenthesis
+      #
+      #   > import Data.Foo (foo)
+      #
+      # Default: false
+      space_surround: false
+
   # Language pragmas
   - language_pragmas:
       # We can generate different styles of language pragma lists.
@@ -142,7 +177,7 @@ steps:
 
       # Align affects alignment of closing pragma brackets.
       #
-      # - true: Brackets are aligned in same collumn.
+      # - true: Brackets are aligned in same column.
       #
       # - false: Brackets are not aligned together. There is only one space
       #   between actual import and closing bracket.

BACKERS.md

@@ -2,13 +2,56 @@
 
 PostgREST ongoing development is only possible thanks to our Sponsors and Backers, listed below. If you'd like to join them, you can do so by supporting the PostgREST organization on [Patreon](https://www.patreon.com/postgrest).
 
+## Sponsors
+
+<table>
+  <tbody>
+    <tr>
+      <td align="center" valign="middle">
+        <a href="https://www.cybertec-postgresql.com/en/" target="_blank">
+          <img width="222px" src="static/cybertec.png">
+        </a>
+      </td>
+      <td align="center" valign="middle">
+        <a href="https://www.2ndquadrant.com/en/?utm_campaign=External%20Websites&utm_source=PostgREST&utm_medium=Logo" target="_blank">
+          <img width="222px" src="static/2ndquadrant.png">
+        </a>
+      </td>
+      <td align="center" valign="middle">
+        <a href="https://tryretool.com/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
+          <img width="222px" src="static/retool.png">
+        </a>
+      </td>
+    </tr>
+  </tbody>
+</table>
+
 ## Lead Backers
 
-- [Christiaan Westerbeek](https://devotis.nl)
 - [Daniel Babiak](https://github.com/d-babiak)
 - [Michel Pelletier](https://github.com/michelp/)
+- Evans Fernandes
 
 ## Backers
 
 - Tsingson Qin
 - Jay Hannah
+- Robert Stolarz
+- Kofi Gumbs
+- Nicholas DiBiase
+
+## Former Backers
+
+<table>
+  <tbody>
+    <tr>
+      <td align="center" valign="middle">
+        <a href="https://www.timescale.com?utm_campaign=postgrest&utm_source=sponsor&utm_medium=referral&utm_content=github" target="_blank">
+          <img width="222px" src="static/timescaledb.png">
+        </a>
+      </td>
+    </tr>
+  </tbody>
+</table>
+
+- [Christiaan Westerbeek](https://devotis.nl)

CHANGELOG.md

@@ -9,6 +9,41 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
 ### Fixed
 
+## [6.0.0] - 2019-06-21
+
+### Added
+
+- #1186, Add support for user defined unix socket via `server-unix-socket` config option
+- #690, Add `?columns` query parameter for faster bulk inserts, also ignores unspecified json keys in a payload - @steve-chavez
+- #1239, Add support for resource embedding on materialized views - @vitorbaptista
+- #1264, Add support for bulk RPC call - @steve-chavez
+- #1278, Add db-pool-timeout config option - @qu4tro
+- #1285, Abort on wrong database password - @qu4tro
+- #790, Allow override of OpenAPI spec through `root-spec` config option - @steve-chavez
+- #1308, Accept `text/plain` and `text/html` for raw output - @steve-chavez
+
+### Fixed
+
+- #1223, Fix incorrect OpenAPI externalDocs url - @steve-chavez
+- #1221, Fix embedding other resources when having a self join - @steve-chavez
+- #1242, Fix embedding a view having a select in a where - @steve-chavez
+- #1238, Fix PostgreSQL to OpenAPI type mappings for numeric and character types - @fpusch
+- #1265, Fix query generated on bulk upsert with an empty array - @qu4tro
+- #1273, Fix RPC ignoring unknown arguments by default - @steve-chavez
+- #1257, Fix incorrect status when a PATCH request doesn't find rows to change - @qu4tro
+
+### Changed
+
+- #1288, Change server-host default of 127.0.0.1 to !4
+
+### Deprecated
+
+- #1288, Deprecate `.` symbol for disambiguating resource embedding(added in #918). '+' should be used instead. Though '+' is url safe, certain clients might need to encode it to '%2B'.
+
+### Removed
+
+- #1288, Removed support for schema reloading with SIGHUP, SIGUSR1 should be used instead - @steve-chavez
+
 ## [5.2.0] - 2018-12-12
 
 ### Added

Makefile

@@ -0,0 +1,40 @@
+.PHONY: check clean lint style test test-watch coverage circleci circleci-prof-test check-dburi prompt-clean prompt-long-process
+
+check: lint style test
+
+clean: prompt-clean
+	stack clean --full
+
+lint:
+	git ls-files | grep '\.l\?hs$$' | xargs stack exec -- hlint -X QuasiQuotes -X NoPatternSynonyms "$$@"
+
+style:
+	git ls-files | grep '\.l\?hs$$' | xargs stack exec -- stylish-haskell -i
+
+
+test: check-dburi
+	stack test
+
+test-watch: check-dburi
+	stack build --file-watch --test --test-arguments '--rerun --failure-report=.TESTREPORT --rerun-all-on-success'
+
+coverage: check-dburi clean
+	stack build --coverage
+	stack test --coverage
+
+
+circleci: prompt-long-process
+	circleci local execute --job build-test-9.4
+
+circleci-prof-test: prompt-long-process
+	circleci local execute --job build-prof-test
+
+
+check-dburi:
+	test -n "$(POSTGREST_TEST_CONNECTION)" # Requires POSTGREST_TEST_CONNECTION environmental variable
+
+prompt-clean:
+	@echo -n 'Are you sure? You will have to rebuild. [y/N] ' && read ans && [ $${ans:-N} = y ]
+
+prompt-long-process:
+	@echo -n 'Are you sure? This might take a while. [y/N] ' && read ans && [ $${ans:-N} = y ]

README.md

@@ -1,4 +1,4 @@
-![Logo](static/logo.png "Logo")
+![Logo](static/bigger-logo.png "Logo")
 
 [![Donate](https://img.shields.io/badge/Donate-Patreon-orange.svg?colorB=F96854)](https://www.patreon.com/postgrest)
 [![Donate](https://img.shields.io/badge/Donate-PayPal-green.svg)](https://www.paypal.me/postgrest)
@@ -15,6 +15,32 @@ PostgREST serves a fully RESTful API from any existing PostgreSQL
 database. It provides a cleaner, more standards-compliant, faster
 API than you are likely to write from scratch.
 
+## Sponsors
+
+<table>
+  <tbody>
+    <tr>
+      <td align="center" valign="middle">
+        <a href="https://www.cybertec-postgresql.com/en/" target="_blank">
+          <img width="222px" src="static/cybertec.png">
+        </a>
+      </td>
+      <td align="center" valign="middle">
+        <a href="https://www.2ndquadrant.com/en/?utm_campaign=External%20Websites&utm_source=PostgREST&utm_medium=Logo" target="_blank">
+          <img width="222px" src="static/2ndquadrant.png">
+        </a>
+      </td>
+      <td align="center" valign="middle">
+        <a href="https://tryretool.com/?utm_source=sponsor&utm_campaign=postgrest" target="_blank">
+          <img width="222px" src="static/retool.png">
+        </a>
+      </td>
+    </tr>
+  </tbody>
+</table>
+
+Big thanks to our sponsors! You can join them by supporting PostgREST on [Patreon](https://www.patreon.com/postgrest).
+
 ## Usage
 
 1. Download the binary ([latest release](https://github.com/PostgREST/postgrest/releases/latest))

app.json

@@ -10,7 +10,7 @@
     },
     "POSTGREST_VER": {
       "description": "Version of PostgREST to deploy",
-      "value": "5.2.0"
+      "value": "6.0.0"
     },
     "DB_URI": {
       "description": "Database connection string, e.g. postgres://user:pass@xxxxxxx.rds.amazonaws.com/mydb",

docker/Dockerfile

@@ -1,4 +1,4 @@
-FROM debian:jessie
+FROM debian:stretch-slim
 
 ARG POSTGREST_VERSION
 
@@ -28,6 +28,7 @@ ENV PGRST_DB_URI= \
     PGRST_DB_SCHEMA=public \
     PGRST_DB_ANON_ROLE= \
     PGRST_DB_POOL=100 \
+    PGRST_DB_EXTRA_SEARCH_PATH=public \
     PGRST_SERVER_HOST=*4 \
     PGRST_SERVER_PORT=3000 \
     PGRST_SERVER_PROXY_URI= \
@@ -38,6 +39,12 @@ ENV PGRST_DB_URI= \
     PGRST_PRE_REQUEST= \
     PGRST_ROLE_CLAIM_KEY=".role"
 
+RUN groupadd -g 1000 postgrest && \
+    useradd -r -u 1000 -g postgrest postgrest && \
+    chown postgrest:postgrest /etc/postgrest.conf
+
+USER 1000
+
 # PostgREST reads /etc/postgrest.conf so map the configuration
 # file in when you run this container
 CMD exec postgrest /etc/postgrest.conf

docker/postgrest.conf

@@ -2,6 +2,7 @@ db-uri = "$(PGRST_DB_URI)"
 db-schema = "$(PGRST_DB_SCHEMA)"
 db-anon-role = "$(PGRST_DB_ANON_ROLE)"
 db-pool = "$(PGRST_DB_POOL)"
+db-extra-search-path = "$(PGRST_DB_EXTRA_SEARCH_PATH)"
 
 server-host = "$(PGRST_SERVER_HOST)"
 server-port = "$(PGRST_SERVER_PORT)"

main/Main.hs

@@ -2,42 +2,51 @@
 
 module Main where
 
-
-import           PostgREST.App              (postgrest)
-import           PostgREST.Config           (AppConfig (..),
-                                             prettyVersion, readOptions)
-import           PostgREST.DbStructure      (getDbStructure, getPgVersion)
-import           PostgREST.Error            (encodeError)
-import           PostgREST.OpenAPI          (isMalformedProxyUri)
-import           PostgREST.Types            (DbStructure, Schema, PgVersion(..), minimumPgVersion)
-import           Protolude                  hiding (hPutStrLn, replace)
-
-
-import           Control.AutoUpdate         (defaultUpdateSettings,
-                                             mkAutoUpdate, updateAction)
-import           Control.Retry              (RetryStatus, capDelay,
-                                             exponentialBackoff,
-                                             retrying, rsPreviousDelay)
 import qualified Data.ByteString            as BS
 import qualified Data.ByteString.Base64     as B64
-import           Data.IORef                 (IORef, atomicWriteIORef,
-                                             newIORef, readIORef)
-import           Data.String                (IsString (..))
-import           Data.Text                  (pack, replace, stripPrefix, strip)
-import           Data.Text.Encoding         (decodeUtf8, encodeUtf8)
-import           Data.Text.IO               (hPutStrLn, readFile)
-import           Data.Time.Clock            (getCurrentTime)
 import qualified Hasql.Pool                 as P
-import qualified Hasql.Session              as H
 import qualified Hasql.Transaction.Sessions as HT
-import           Network.Wai.Handler.Warp   (defaultSettings,
-                                             runSettings, setHost,
-                                             setPort, setServerName)
-import           System.IO                  (BufferMode (..),
-                                             hSetBuffering)
+
+import Control.AutoUpdate       (defaultUpdateSettings, mkAutoUpdate,
+                                 updateAction)
+import Control.Retry            (RetryStatus, capDelay,
+                                 exponentialBackoff, retrying,
+                                 rsPreviousDelay)
+import Data.IORef               (IORef, atomicWriteIORef, newIORef,
+                                 readIORef)
+import Data.String              (IsString (..))
+import Data.Text                (pack, replace, strip, stripPrefix,
+                                 unpack)
+import Data.Text.Encoding       (decodeUtf8, encodeUtf8)
+import Data.Text.IO             (hPutStrLn, readFile)
+import Data.Time.Clock          (getCurrentTime)
+import Network.Socket           (Family (AF_UNIX),
+                                 SockAddr (SockAddrUnix), Socket,
+                                 SocketType (Stream), bind, close,
+                                 defaultProtocol, listen,
+                                 maxListenQueue, socket)
+import Network.Wai.Handler.Warp (defaultSettings, runSettings,
+                                 runSettingsSocket, setHost, setPort,
+                                 setServerName)
+import System.Directory         (removeFile)
+import System.IO                (BufferMode (..), hSetBuffering)
+import System.IO.Error          (isDoesNotExistError)
+
+import PostgREST.App         (postgrest)
+import PostgREST.Config      (AppConfig (..), configPoolTimeout',
+                              prettyVersion, readOptions)
+import PostgREST.DbStructure (getDbStructure, getPgVersion)
+import PostgREST.Error       (PgError (PgError), checkIsFatal,
+                              errorPayload)
+import PostgREST.OpenAPI     (isMalformedProxyUri)
+import PostgREST.Types       (ConnectionStatus (..), DbStructure,
+                              PgVersion (..), Schema,
+                              minimumPgVersion)
+import Protolude             hiding (hPutStrLn, replace)
+
 
 #ifndef mingw32_HOST_OS
-import           System.Posix.Signals
+import System.Posix.Signals
 #endif
 
 {-|
@@ -74,25 +83,24 @@ connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
     work = do
       atomicWriteIORef refDbStructure Nothing
       putStrLn ("Attempting to connect to the database..." :: Text)
-      connected <- connectingSucceeded pool
-      when connected $ do
-        result <- P.use pool $ do
-          actualPgVersion <- getPgVersion
-          unless (actualPgVersion >= minimumPgVersion) $ liftIO $ do
-            hPutStrLn stderr
-              ("Cannot run in this PostgreSQL version, PostgREST needs at least "
-              <> pgvName minimumPgVersion)
-            killThread mainTid
-          dbStructure <- HT.transaction HT.ReadCommitted HT.Read $ getDbStructure schema actualPgVersion
-          liftIO $ atomicWriteIORef refDbStructure $ Just dbStructure
-        case result of
-          Left e -> do
-            putStrLn ("Failed to query the database. Retrying." :: Text)
-            hPutStrLn stderr (toS $ encodeError e)
-            work
-          Right _ -> do
-            atomicWriteIORef refIsWorkerOn False
-            putStrLn ("Connection successful" :: Text)
+      connected <- connectionStatus pool
+      case connected of
+        FatalConnectionError reason -> hPutStrLn stderr reason
+                                      >> killThread mainTid    -- Fatal error when connecting
+        NotConnected                -> return ()               -- Unreachable
+        Connected actualPgVersion   -> do                      -- Procede with initialization
+          result <- P.use pool $ do
+            dbStructure <- HT.transaction HT.ReadCommitted HT.Read $ getDbStructure schema actualPgVersion
+            liftIO $ atomicWriteIORef refDbStructure $ Just dbStructure
+          case result of
+            Left e -> do
+              putStrLn ("Failed to query the database. Retrying." :: Text)
+              hPutStrLn stderr . toS . errorPayload $ PgError False e
+              work
+
+            Right _ -> do
+              atomicWriteIORef refIsWorkerOn False
+              putStrLn ("Connection successful" :: Text)
 
 {-|
   Used by 'connectionWorker' to check if the provided db-uri lets
@@ -103,26 +111,37 @@ connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
   The connection tries are capped, but if the connection times out no error is
   thrown, just 'False' is returned.
 -}
-connectingSucceeded :: P.Pool -> IO Bool
-connectingSucceeded pool =
+connectionStatus :: P.Pool -> IO ConnectionStatus
+connectionStatus pool =
   retrying (capDelay 32000000 $ exponentialBackoff 1000000)
            shouldRetry
-           (const $ P.release pool >> isConnectionSuccessful)
+           (const $ P.release pool >> getConnectionStatus)
   where
-    isConnectionSuccessful :: IO Bool
-    isConnectionSuccessful = do
-      testConn <- P.use pool $ H.sql "SELECT 1"
-      case testConn of
-        Left e -> hPutStrLn stderr (toS $ encodeError e) >> pure False
-        _ -> pure True
-    shouldRetry :: RetryStatus -> Bool -> IO Bool
+    getConnectionStatus :: IO ConnectionStatus
+    getConnectionStatus = do
+      pgVersion <- P.use pool getPgVersion
+      case pgVersion of
+        Left e -> do
+          let err = PgError False e
+          hPutStrLn stderr . toS $ errorPayload err
+          case checkIsFatal err of
+            Just reason -> return $ FatalConnectionError reason
+            Nothing     -> return NotConnected
+
+        Right version ->
+          if version < minimumPgVersion
+             then return . FatalConnectionError $ "Cannot run in this PostgreSQL version, PostgREST needs at least " <> pgvName minimumPgVersion
+             else return . Connected  $ version
+
+    shouldRetry :: RetryStatus -> ConnectionStatus -> IO Bool
     shouldRetry rs isConnSucc = do
-      delay <- pure $ fromMaybe 0 (rsPreviousDelay rs) `div` 1000000
-      itShould <- pure $ not isConnSucc
+      let delay    = fromMaybe 0 (rsPreviousDelay rs) `div` 1000000
+          itShould = NotConnected == isConnSucc
       when itShould $
         putStrLn $ "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..."
       return itShould
 
+
 {-|
   This is where everything starts.
 -}
@@ -143,6 +162,7 @@ main = do
   let host = configHost conf
       port = configPort conf
       proxy = configProxyUri conf
+      maybeSocketAddr = configSocket conf
       pgSettings = toS (configDatabase conf) -- is the db-uri
       roleClaimKey = configRoleClaimKey conf
       appSettings =
@@ -160,11 +180,10 @@ main = do
   when (isLeft roleClaimKey) $
     panic $ show roleClaimKey
 
-  putStrLn $ ("Listening on port " :: Text) <> show (configPort conf)
   --
   -- create connection pool with the provided settings, returns either
   -- a 'Connection' or a 'ConnectionError'. Does not throw.
-  pool <- P.acquire (configPool conf, 10, pgSettings)
+  pool <- P.acquire (configPool conf, configPoolTimeout' conf, pgSettings)
   --
   -- To be filled in by connectionWorker
   refDbStructure <- newIORef Nothing
@@ -198,34 +217,45 @@ main = do
         throwTo mainTid UserInterrupt
       ) Nothing
 
-  forM_ [sigHUP, sigUSR1] $ \sig ->
-    void $ installHandler sig (
-      Catch $ connectionWorker
-                mainTid
-                pool
-                (configSchema conf)
-                refDbStructure
-                refIsWorkerOn
-      ) Nothing
+  void $ installHandler sigUSR1 (
+    Catch $ connectionWorker
+              mainTid
+              pool
+              (configSchema conf)
+              refDbStructure
+              refIsWorkerOn
+    ) Nothing
 #endif
 
 
   -- ask for the OS time at most once per second
   getTime <- mkAutoUpdate defaultUpdateSettings {updateAction = getCurrentTime}
 
-  -- run the postgrest application
-  runSettings appSettings $
-    postgrest
-      conf
-      refDbStructure
-      pool
-      getTime
-      (connectionWorker
-         mainTid
-         pool
-         (configSchema conf)
-         refDbStructure
-         refIsWorkerOn)
+  let postgrestApplication =
+        postgrest
+          conf
+          refDbStructure
+          pool
+          getTime
+          (connectionWorker
+             mainTid
+             pool
+             (configSchema conf)
+             refDbStructure
+             refIsWorkerOn)
+    in case maybeSocketAddr of
+         Nothing -> do
+             -- run the postgrest application
+             putStrLn $ ("Listening on port " :: Text) <> show (configPort conf)
+             runSettings appSettings postgrestApplication
+         Just socketAddr -> do
+             -- run postgrest application with user defined socket
+             sock <- createAndBindSocket (unpack socketAddr)
+             listen sock maxListenQueue
+             putStrLn $ ("Listening on unix socket " :: Text) <> show socketAddr
+             runSettingsSocket appSettings sock postgrestApplication
+             -- clean socket up when done
+             close sock
 
 {-|
   The purpose of this function is to load the JWT secret from a file if
@@ -290,6 +320,18 @@ loadDbUriFile conf = extractDbUri mDbUri
     extractDbUri dbUri =
       fmap setDbUri $
       case stripPrefix "@" dbUri of
-        Nothing -> return dbUri
+        Nothing       -> return dbUri
         Just filename -> strip <$> readFile (toS filename)
     setDbUri dbUri = conf {configDatabase = dbUri}
+
+createAndBindSocket :: FilePath -> IO Socket
+createAndBindSocket filePath = do
+  deleteSocketFileIfExist filePath
+  sock <- socket AF_UNIX Stream defaultProtocol
+  bind sock $ SockAddrUnix filePath
+  return sock
+  where
+    deleteSocketFileIfExist path = removeFile path `catch` handleDoesNotExist
+    handleDoesNotExist e
+      | isDoesNotExistError e = return ()
+      | otherwise = throwIO e

postgrest.cabal

@@ -1,176 +1,182 @@
-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:               5.2.0
-synopsis:              REST API for any Postgres database
-license:               MIT
-license-file:          LICENSE
-author:                Joe Nelson, Adam Baker
-homepage:              https://postgrest.org
-maintainer:            Steve Chávez <stevechavezast@gmail.com>
-bug-reports:           https://github.com/PostgREST/postgrest/issues
-category:              Executable, PostgreSQL, Network APIs
-extra-source-files:    CHANGELOG.md
-build-type:            Simple
-cabal-version:         >=1.10
+name:               postgrest
+version:            6.0.0
+synopsis:           REST API for any Postgres database
+description:        Reads the schema of a PostgreSQL database and creates RESTful routes
+                    for the tables and views, supporting all HTTP verbs that security
+                    permits.
+license:            MIT
+license-file:       LICENSE
+author:             Joe Nelson, Adam Baker
+maintainer:         Steve Chávez <stevechavezast@gmail.com>
+category:           Executable, PostgreSQL, Network APIs
+homepage:           https://postgrest.org
+bug-reports:        https://github.com/PostgREST/postgrest/issues
+build-type:         Simple
+extra-source-files: CHANGELOG.md
+cabal-version:      >= 1.10
+
 source-repository head
-  type: git
+  type:     git
   location: git://github.com/PostgREST/postgrest.git
 
-Flag CI
-  Description: No warnings allowed in continuous integration
-  Manual:      True
-  Default:     False
-
-executable postgrest
-  main-is:             Main.hs
-  default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
-  ghc-options:
-    -threaded
-    -rtsopts
-    "-with-rtsopts=-N -I2"
-  default-language:    Haskell2010
-  build-depends:       auto-update
-                     , base >= 4.8 && < 4.10
-                     , hasql >= 1.3 && < 1.4
-                     , hasql-pool >= 0.5 && < 0.6
-                     , hasql-transaction >= 0.7 && < 0.8
-                     , postgrest
-                     , protolude == 0.2.2
-                     , text
-                     , time
-                     , warp
-                     , bytestring
-                     , base64-bytestring
-                     , retry
-  if !os(windows)
-    build-depends:     unix
-
-  hs-source-dirs:      main
+flag ci
+  default:     False
+  manual:      True
+  description: No warnings allowed in continuous integration
 
 library
-  default-language:    Haskell2010
-  default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
-  build-depends:       aeson
-                     , ansi-wl-pprint
-                     , base >= 4.8 && < 4.10
-                     , base64-bytestring
-                     , bytestring
-                     , case-insensitive
-                     , cassava
-                     , configurator-ng == 0.0.0.1
-                     , containers
-                     , contravariant
-                     , contravariant-extras
-                     , either
-                     , gitrev
-                     , hasql >= 1.3 && < 1.4
-                     , hasql-pool >= 0.5 && < 0.6
-                     , hasql-transaction >= 0.7 && < 0.8
-                     , heredoc
-                     , HTTP
-                     , http-types
-                     , insert-ordered-containers
-                     , interpolatedstring-perl6
-                     , jose == 0.7.0.0
-                     , lens
-                     , lens-aeson
-                     , network-uri
-                     , optparse-applicative >= 0.13 && < 0.15
-                     , parsec
-                     , protolude == 0.2.2
-                     , Ranged-sets == 0.3.0
-                     , regex-tdfa
-                     , scientific
-                     , swagger2
-                     , text
-                     , time
-                     , unordered-containers
-                     , vector
-                     , wai
-                     , wai-cors
-                     , wai-extra
-                     , wai-middleware-static
-                     , cookie
+  exposed-modules:    PostgREST.ApiRequest
+                      PostgREST.App
+                      PostgREST.Auth
+                      PostgREST.Config
+                      PostgREST.DbRequestBuilder
+                      PostgREST.DbStructure
+                      PostgREST.Error
+                      PostgREST.Middleware
+                      PostgREST.OpenAPI
+                      PostgREST.Parsers
+                      PostgREST.QueryBuilder
+                      PostgREST.RangeQuery
+                      PostgREST.Types
+  other-modules:      Paths_postgrest
+  hs-source-dirs:     src
+  build-depends:      base                      >= 4.9 && < 4.13
+                    , HTTP                      >= 4000.3.7 && < 4000.4
+                    , Ranged-sets               >= 0.3 && < 0.5
+                    , aeson                     >= 0.11.3 && < 1.5
+                    , ansi-wl-pprint            >= 0.6.7 && < 0.7
+                    , base64-bytestring         >= 1 && < 1.1
+                    , bytestring                >= 0.10.8 && < 0.11
+                    , case-insensitive          >= 1.2 && < 1.3
+                    , cassava                   >= 0.4.5 && < 0.6
+                    , configurator-pg           >= 0.1 && < 0.2
+                    , containers                >= 0.5.7 && < 0.7
+                    , contravariant             >= 1.4 && < 1.6
+                    , contravariant-extras      >= 0.3.3 && < 0.4
+                    , cookie                    >= 0.4.2 && < 0.5
+                    , either                    >= 4.4.1 && < 5.1
+                    , gitrev                    >= 1.2 && < 1.4
+                    , hasql                     >= 1.4 && < 1.5
+                    , hasql-pool                >= 0.5 && < 0.6
+                    , hasql-transaction         >= 0.7.2 && < 0.8
+                    , heredoc                   >= 0.2 && < 0.3
+                    , http-types                >= 0.12.2 && < 0.13
+                    , insert-ordered-containers >= 0.1 && < 0.3
+                    , interpolatedstring-perl6  >= 1 && < 1.1
+                    , jose                      >= 0.7 && < 0.8
+                    , lens                      >= 4.14 && < 4.18
+                    , lens-aeson                >= 1.0.1 && < 1.1
+                    , network-uri               >= 2.6.1 && < 2.7
+                    , optparse-applicative      >= 0.13 && < 0.15
+                    , parsec                    >= 3.1.11 && < 3.2
+                    , protolude                 >= 0.2.2 && < 0.3
+                    , regex-tdfa                >= 1.2.2 && < 1.3
+                    , scientific                >= 0.3.4 && < 0.4
+                    , swagger2                  >= 2.1.4 && < 2.4
+                    , text                      >= 1.2.2 && < 1.3
+                    , time                      >= 1.6 && < 1.9
+                    , unordered-containers      >= 0.2.8 && < 0.3
+                    , vector                    >= 0.11 && < 0.13
+                    , wai                       >= 3.2.1 && < 3.3
+                    , wai-cors                  >= 0.2.5 && < 0.3
+                    , wai-extra                 >= 3.0.19 && < 3.1
+                    , wai-middleware-static     >= 0.8.1 && < 0.9
+  default-language:   Haskell2010
+  default-extensions: OverloadedStrings
+                      QuasiQuotes
+                      NoImplicitPrelude
 
-  Other-Modules:       Paths_postgrest
-  Exposed-Modules:     PostgREST.ApiRequest
-                     , PostgREST.App
-                     , PostgREST.Auth
-                     , PostgREST.Config
-                     , PostgREST.DbStructure
-                     , PostgREST.DbRequestBuilder
-                     , PostgREST.Error
-                     , PostgREST.Middleware
-                     , PostgREST.OpenAPI
-                     , PostgREST.Parsers
-                     , PostgREST.QueryBuilder
-                     , PostgREST.RangeQuery
-                     , PostgREST.Types
-  hs-source-dirs:      src
+executable postgrest
+  main-is:            Main.hs
+  hs-source-dirs:     main
+  build-depends:      base              >= 4.9 && < 4.13
+                    , auto-update       >= 0.1.4 && < 0.2
+                    , base64-bytestring >= 1 && < 1.1
+                    , bytestring        >= 0.10.8 && < 0.11
+                    , directory         >= 1.2.6 && < 1.4
+                    , hasql             >= 1.4 && < 1.5
+                    , hasql-pool        >= 0.5 && < 0.6
+                    , hasql-transaction >= 0.7.2 && < 0.8
+                    , network           < 2.9
+                    , postgrest
+                    , protolude         >= 0.2.2 && < 0.3
+                    , retry             >= 0.7.4 && < 0.9
+                    , text              >= 1.2.2 && < 1.3
+                    , time              >= 1.6 && < 1.9
+                    , warp              >= 3.2.12 && < 3.3
+  default-language:   Haskell2010
+  default-extensions: OverloadedStrings
+                      QuasiQuotes
+                      NoImplicitPrelude
+  ghc-options:        -threaded -rtsopts "-with-rtsopts=-N -I2"
 
-Test-Suite spec
-  Type:                exitcode-stdio-1.0
-  Default-Language:    Haskell2010
-  default-extensions:  OverloadedStrings, QuasiQuotes, NoImplicitPrelude
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
-  Hs-Source-Dirs:      test
-  Main-Is:             Main.hs
-  Other-Modules:       Feature.AudienceJwtSecretSpec
-                     , Feature.AuthSpec
-                     , Feature.AsymmetricJwtSpec
-                     , Feature.BinaryJwtSecretSpec
-                     , Feature.ConcurrentSpec
-                     , Feature.CorsSpec
-                     , Feature.DeleteSpec
-                     , Feature.ExtraSearchPathSpec
-                     , Feature.InsertSpec
-                     , Feature.JsonOperatorSpec
-                     , Feature.NoJwtSpec
-                     , Feature.PgVersion95Spec
-                     , Feature.PgVersion96Spec
-                     , Feature.ProxySpec
-                     , Feature.QueryLimitedSpec
-                     , Feature.QuerySpec
-                     , Feature.RangeSpec
-                     , Feature.SingularSpec
-                     , Feature.StructureSpec
-                     , Feature.UnicodeSpec
-                     , Feature.AndOrParamsSpec
-                     , Feature.RpcSpec
-                     , Feature.NonexistentSchemaSpec
-                     , Feature.UpsertSpec
-                     , SpecHelper
-                     , TestTypes
-  Build-Depends:       aeson
-                     , aeson-qq
-                     , async
-                     , auto-update
-                     , base >= 4.8 && < 4.10
-                     , bytestring
-                     , base64-bytestring
-                     , case-insensitive
-                     , cassava
-                     , containers
-                     , contravariant
-                     , hasql >= 1.3 && < 1.4
-                     , hasql-pool >= 0.5 && < 0.6
-                     , hasql-transaction >= 0.7 && < 0.8
-                     , heredoc
-                     , hjsonschema == 1.5.0.1
-                     , hspec
-                     , hspec-wai >= 0.7.0
-                     , hspec-wai-json
-                     , http-types
-                     , lens
-                     , lens-aeson
-                     , monad-control
-                     , postgrest
-                     , process
-                     , protolude == 0.2.2
-                     , regex-tdfa
-                     , time
-                     , transformers-base
-                     , wai
-                     , wai-extra
+  if !os(windows)
+    build-depends: unix
+
+test-suite spec
+  type:               exitcode-stdio-1.0
+  main-is:            Main.hs
+  other-modules:      Feature.AndOrParamsSpec
+                      Feature.AsymmetricJwtSpec
+                      Feature.AudienceJwtSecretSpec
+                      Feature.AuthSpec
+                      Feature.BinaryJwtSecretSpec
+                      Feature.ConcurrentSpec
+                      Feature.CorsSpec
+                      Feature.DeleteSpec
+                      Feature.ExtraSearchPathSpec
+                      Feature.InsertSpec
+                      Feature.JsonOperatorSpec
+                      Feature.NoJwtSpec
+                      Feature.NonexistentSchemaSpec
+                      Feature.PgVersion95Spec
+                      Feature.PgVersion96Spec
+                      Feature.ProxySpec
+                      Feature.QueryLimitedSpec
+                      Feature.QuerySpec
+                      Feature.RangeSpec
+                      Feature.RootSpec
+                      Feature.RpcSpec
+                      Feature.SingularSpec
+                      Feature.StructureSpec
+                      Feature.UnicodeSpec
+                      Feature.UpsertSpec
+                      SpecHelper
+                      TestTypes
+  hs-source-dirs:     test
+  build-depends:      base              >= 4.9 && < 4.13
+                    , aeson             >= 0.11.3 && < 1.5
+                    , aeson-qq          >= 0.8.1 && < 0.9
+                    , async             >= 2.1.1 && < 2.3
+                    , auto-update       >= 0.1.4 && < 0.2
+                    , base64-bytestring >= 1 && < 1.1
+                    , bytestring        >= 0.10.8 && < 0.11
+                    , case-insensitive  >= 1.2 && < 1.3
+                    , cassava           >= 0.4.5 && < 0.6
+                    , containers        >= 0.5.7 && < 0.7
+                    , contravariant     >= 1.4 && < 1.6
+                    , hasql             >= 1.4 && < 1.5
+                    , hasql-pool        >= 0.5 && < 0.6
+                    , hasql-transaction >= 0.7.2 && < 0.8
+                    , heredoc           >= 0.2 && < 0.3
+                    , hspec             >= 2.3 && < 2.8
+                    , hspec-wai         >= 0.7 && < 0.10
+                    , hspec-wai-json    >= 0.7 && < 0.10
+                    , http-types        >= 0.12.3 && < 0.13
+                    , lens              >= 4.14 && < 4.18
+                    , lens-aeson        >= 1.0.1 && < 1.1
+                    , monad-control     >= 1.0.1 && < 1.1
+                    , postgrest
+                    , process           >= 1.4.2 && < 1.7
+                    , protolude         >= 0.2.2 && < 0.3
+                    , regex-tdfa        >= 1.2.2 && < 1.3
+                    , text              >= 1.2.2 && < 1.3
+                    , time              >= 1.6 && < 1.9
+                    , transformers-base >= 0.4.4 && < 0.5
+                    , wai               >= 3.2.1 && < 3.3
+                    , wai-extra         >= 3.0.19 && < 3.1
+  default-language:   Haskell2010
+  default-extensions: OverloadedStrings
+                      QuasiQuotes
+                      NoImplicitPrelude
+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N

scripts/release_s3.sh

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

src/PostgREST/ApiRequest.hs

@@ -1,43 +1,53 @@
-{-# LANGUAGE LambdaCase #-}
 {-|
 Module      : PostgREST.ApiRequest
 Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
 -}
-module PostgREST.ApiRequest ( ApiRequest(..)
-                            , ContentType(..)
-                            , Action(..)
-                            , Target(..)
-                            , PreferRepresentation (..)
-                            , mutuallyAgreeable
-                            , userApiRequest
-                            ) where
+{-# LANGUAGE LambdaCase #-}
 
-import           Protolude
-import qualified Data.Aeson                as JSON
-import           Data.Aeson.Types          (emptyObject, emptyArray)
-import qualified Data.ByteString           as BS
-import qualified Data.ByteString.Internal  as BS (c2w)
-import qualified Data.ByteString.Lazy      as BL
-import qualified Data.Csv                  as CSV
-import qualified Data.List                 as L
-import           Data.List                 (lookup, last, partition)
-import qualified Data.HashMap.Strict       as M
-import qualified Data.Set                  as S
-import           Data.Maybe                (fromJust)
-import           Control.Arrow             ((***))
-import qualified Data.Text                 as T
-import qualified Data.Vector               as V
-import           Network.HTTP.Base         (urlEncodeVars)
-import           Network.HTTP.Types.Header (hAuthorization, hCookie)
-import           Network.HTTP.Types.URI    (parseSimpleQuery)
-import           Network.Wai               (Request (..))
-import           Network.Wai.Parse         (parseHttpAccept)
-import           PostgREST.RangeQuery      (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange, rangeLimit, rangeOffset)
-import           Data.Ranged.Boundaries
-import           PostgREST.Types
-import           Data.Ranged.Ranges        (Range(..), rangeIntersection, emptyRange)
-import qualified Data.CaseInsensitive      as CI
-import           Web.Cookie                (parseCookiesText)
+module PostgREST.ApiRequest (
+  ApiRequest(..)
+, ContentType(..)
+, Action(..)
+, Target(..)
+, PreferRepresentation (..)
+, mutuallyAgreeable
+, userApiRequest
+) where
+
+import qualified Data.Aeson           as JSON
+import qualified Data.ByteString      as BS
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.CaseInsensitive as CI
+import qualified Data.Csv             as CSV
+import qualified Data.HashMap.Strict  as M
+import qualified Data.List            as L
+import qualified Data.Set             as S
+import qualified Data.Text            as T
+import qualified Data.Vector          as V
+
+import Control.Arrow             ((***))
+import Data.Aeson.Types          (emptyArray, emptyObject)
+import Data.List                 (last, lookup, partition)
+import Data.Maybe                (fromJust)
+import Data.Ranged.Ranges        (Range (..), emptyRange,
+                                  rangeIntersection)
+import Network.HTTP.Base         (urlEncodeVars)
+import Network.HTTP.Types.Header (hAuthorization, hCookie)
+import Network.HTTP.Types.URI    (parseQueryReplacePlus,
+                                  parseSimpleQuery)
+import Network.Wai               (Request (..))
+import Network.Wai.Parse         (parseHttpAccept)
+import Web.Cookie                (parseCookiesText)
+
+
+import Data.Ranged.Boundaries
+
+import PostgREST.Error      (ApiRequestError (..))
+import PostgREST.RangeQuery (NonnegRange, allRange, rangeGeq,
+                             rangeLimit, rangeOffset, rangeRequested,
+                             restrictRange)
+import PostgREST.Types
+import Protolude
 
 type RequestBody = BL.ByteString
 
@@ -49,8 +59,8 @@ data Action = ActionCreate  | ActionRead
             deriving Eq
 -- | The target db object of a user action
 data Target = TargetIdent QualifiedIdentifier
-            | TargetProc  QualifiedIdentifier
-            | TargetRoot
+            | TargetProc{tpQi :: QualifiedIdentifier, tpIsRootSpec :: Bool}
+            | TargetDefaultSpec -- The default spec offered at root "/"
             | TargetUnknown [Text]
             deriving Eq
 -- | How to return the inserted data
@@ -65,44 +75,46 @@ data PreferRepresentation = Full | HeadersOnly | None deriving Eq
 -}
 data ApiRequest = ApiRequest {
   -- | Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
-    iAction :: Action
+    iAction                      :: Action
   -- | Requested range of rows within response
-  , iRange  :: M.HashMap ByteString NonnegRange
+  , iRange                       :: M.HashMap ByteString NonnegRange
   -- | The target, be it calling a proc or accessing a table
-  , iTarget :: Target
+  , iTarget                      :: Target
   -- | Content types the client will accept, [CTAny] if no Accept header
-  , iAccepts :: [ContentType]
+  , iAccepts                     :: [ContentType]
   -- | Data sent by client and used for mutation actions
-  , iPayload :: Maybe PayloadJSON
+  , iPayload                     :: Maybe PayloadJSON
   -- | If client wants created items echoed back
-  , iPreferRepresentation :: PreferRepresentation
+  , iPreferRepresentation        :: PreferRepresentation
   -- | Pass all parameters as a single json object to a stored procedure
   , iPreferSingleObjectParameter :: Bool
   -- | Whether the client wants a result count (slower)
-  , iPreferCount :: Bool
+  , iPreferCount                 :: Bool
   -- | Whether the client wants to UPSERT or ignore records on PK conflict
-  , iPreferResolution :: Maybe PreferResolution
+  , iPreferResolution            :: Maybe PreferResolution
   -- | Filters on the result ("id", "eq.10")
-  , iFilters :: [(Text, Text)]
+  , iFilters                     :: [(Text, Text)]
   -- | &and and &or parameters used for complex boolean logic
-  , iLogic :: [(Text, Text)]
+  , iLogic                       :: [(Text, Text)]
   -- | &select parameter used to shape the response
-  , iSelect :: Text
+  , iSelect                      :: Text
+  -- | &columns parameter used to shape the payload
+  , iColumns                     :: Maybe Text
   -- | &order parameters for each level
-  , iOrder :: [(Text, Text)]
+  , iOrder                       :: [(Text, Text)]
   -- | Alphabetized (canonical) request query string for response URLs
-  , iCanonicalQS :: ByteString
+  , iCanonicalQS                 :: ByteString
   -- | JSON Web Token
-  , iJWT :: Text
+  , iJWT                         :: Text
   -- | HTTP request headers
-  , iHeaders :: [(Text, Text)]
+  , iHeaders                     :: [(Text, Text)]
   -- | Request Cookies
-  , iCookies :: [(Text, Text)]
+  , iCookies                     :: [(Text, Text)]
   }
 
 -- | Examines HTTP request and translates it into user intent.
-userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest
-userApiRequest schema req reqBody
+userApiRequest :: Schema -> Maybe QualifiedIdentifier -> Request -> RequestBody -> Either ApiRequestError ApiRequest
+userApiRequest schema rootSpec req reqBody
   | isTargetingProc && method `notElem` ["GET", "POST"] = Left ActionInappropriate
   | topLevelRange == emptyRange = Left InvalidRange
   | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) witness payload
@@ -120,51 +132,64 @@ userApiRequest schema req reqBody
                             else Nothing
       , iFilters = filters
       , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
-      , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
+      , iSelect = toS $ fromMaybe "*" $ join $ lookup "select" qParams
+      , iColumns = columns
       , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
       , iCanonicalQS = toS $ urlEncodeVars
-        . L.sortBy (comparing fst)
-        . map (join (***) toS)
-        . parseSimpleQuery
-        $ rawQueryString req
+        . L.sortOn fst
+        . map (join (***) toS . second (fromMaybe BS.empty))
+        $ queryStringWPlus
       , iJWT = tokenStr
       , iHeaders = [ (toS $ CI.foldedCase k, toS v) | (k,v) <- hdrs, k /= hAuthorization, k /= hCookie]
       , iCookies = maybe [] parseCookiesText $ lookupHeader "Cookie"
       }
  where
+  -- queryString with '+' not converted to ' '
+  queryStringWPlus = parseQueryReplacePlus False $ rawQueryString req
   -- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
   (filters, rpcQParams) =
     case action of
       ActionInvoke{isReadOnly=True} -> partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
       _ -> (flts, [])
-  flts = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
+  flts =
+    [ (toS k, toS $ fromJust v) |
+      (k,v) <- qParams, isJust v,
+      k `notElem` ["select", "columns"],
+      not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
   hasOperator val = any (`T.isPrefixOf` val) $
                       ((<> ".") <$> "not":M.keys operators) ++
                       ((<> "(") <$> M.keys ftsOperators)
   isEmbedPath = T.isInfixOf "."
-  isTargetingProc = (== Just "rpc") $ listToMaybe path
+  isTargetingProc = case target of
+    TargetProc _ _ -> True
+    _              -> False
+  contentType = decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type"
+  columns | action `elem` [ActionCreate, ActionUpdate, ActionInvoke{isReadOnly=False}] = toS <$> join (lookup "columns" qParams)
+          | otherwise = Nothing
   payload =
-    case (decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type", action) of
+    case (contentType, action) of
       (_, ActionInvoke{isReadOnly=True}) ->
-        Right $ PayloadJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> rpcQParams) PJObject (S.fromList $ fst <$> rpcQParams)
+        Right $ ProcessedJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> rpcQParams) PJObject (S.fromList $ fst <$> rpcQParams)
       (CTApplicationJSON, _) ->
-        note "All object keys must match" . payloadAttributes reqBody
-          =<< if BL.null reqBody && isTargetingProc
-               then Right emptyObject
-               else JSON.eitherDecode reqBody
+        if isJust columns
+          then Right $ RawJSON reqBody
+          else note "All object keys must match" . payloadAttributes reqBody
+                 =<< if BL.null reqBody && isTargetingProc
+                       then Right emptyObject
+                       else JSON.eitherDecode reqBody
       (CTTextCSV, _) -> do
         json <- csvToJson <$> CSV.decodeByName reqBody
         note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
       (CTOther "application/x-www-form-urlencoded", _) ->
         let json = M.fromList . map (toS *** JSON.String . toS) . parseSimpleQuery $ toS reqBody
             keys = S.fromList $ M.keys json in
-        Right $ PayloadJSON (JSON.encode json) PJObject keys
+        Right $ ProcessedJSON (JSON.encode json) PJObject keys
       (ct, _) ->
         Left $ toS $ "Content-Type not acceptable: " <> toMime ct
   topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges
   action =
     case method of
-      "GET"      | target == TargetRoot -> ActionInspect
+      "GET"      | target == TargetDefaultSpec -> ActionInspect
                  | isTargetingProc -> ActionInvoke{isReadOnly=True}
                  | otherwise -> ActionRead
 
@@ -177,19 +202,20 @@ userApiRequest schema req reqBody
       "OPTIONS" -> ActionInfo
       _         -> ActionInspect
   target = case path of
-              []            -> TargetRoot
-              [table]       -> TargetIdent
-                              $ QualifiedIdentifier schema table
-              ["rpc", proc] -> TargetProc
-                              $ QualifiedIdentifier schema proc
-              other         -> TargetUnknown other
+    []            -> case rootSpec of
+                       Just rsQi -> TargetProc rsQi True
+                       Nothing   -> TargetDefaultSpec
+    [table]       -> TargetIdent $ QualifiedIdentifier schema table
+    ["rpc", proc] -> TargetProc (QualifiedIdentifier schema proc) False
+    other         -> TargetUnknown other
+
   shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionInvoke{isReadOnly=False}, ActionInvoke{isReadOnly=True}]
   relevantPayload | shouldParsePayload = rightToMaybe payload
                   | otherwise = Nothing
   path            = pathInfo req
   method          = requestMethod req
   hdrs            = requestHeaders req
-  qParams         = [(toS k, v)|(k,v) <- queryString req]
+  qParams         = [(toS k, v)|(k,v) <- queryStringWPlus]
   lookupHeader    = flip lookup hdrs
   hasPrefer :: Text -> Bool
   hasPrefer val   = any (\(h,v) -> h == "Prefer" && val `elem` split v) hdrs
@@ -237,23 +263,6 @@ mutuallyAgreeable sProduces cAccepts =
      then listToMaybe sProduces
      else exact
 
--- PRIVATE ---------------------------------------------------------------
-
-{-|
-  Warning: discards MIME parameters
--}
-decodeContentType :: BS.ByteString -> ContentType
-decodeContentType ct =
-  case BS.takeWhile (/= BS.c2w ';') ct of
-    "application/json"                  -> CTApplicationJSON
-    "text/csv"                          -> CTTextCSV
-    "application/openapi+json"          -> CTOpenAPI
-    "application/vnd.pgrst.object+json" -> CTSingularJSON
-    "application/vnd.pgrst.object"      -> CTSingularJSON
-    "application/octet-stream"          -> CTOctetStream
-    "*/*"                               -> CTAny
-    ct'                                 -> CTOther ct'
-
 type CsvData = V.Vector (M.HashMap Text BL.ByteString)
 
 {-|
@@ -291,14 +300,14 @@ payloadAttributes raw json =
                 JSON.Object x -> S.fromList (M.keys x) == canonicalKeys
                 _ -> False) arr in
           if areKeysUniform
-            then Just $ PayloadJSON raw (PJArray $ V.length arr) canonicalKeys
+            then Just $ ProcessedJSON raw (PJArray $ V.length arr) canonicalKeys
             else Nothing
         Just _ -> Nothing
         Nothing -> Just emptyPJArray
 
-    JSON.Object o -> Just $ PayloadJSON raw PJObject (S.fromList $ M.keys o)
+    JSON.Object o -> Just $ ProcessedJSON raw PJObject (S.fromList $ M.keys o)
 
     -- truncate everything else to an empty array.
     _ -> Just emptyPJArray
   where
-    emptyPJArray = PayloadJSON (JSON.encode emptyArray) (PJArray 0) S.empty
+    emptyPJArray = ProcessedJSON (JSON.encode emptyArray) (PJArray 0) S.empty

src/PostgREST/App.hs

@@ -1,66 +1,56 @@
 {-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE NamedFieldPuns #-}
 
 module PostgREST.App (
   postgrest
 ) where
 
-import           Control.Applicative
-import           Data.Aeson                as JSON
-import qualified Data.ByteString.Char8     as BS
-import           Data.Maybe
-import           Data.IORef                (IORef, readIORef)
-import           Data.Text                 (intercalate)
-import           Data.Time.Clock           (UTCTime)
-import qualified Data.Set                  as S
-
+import qualified Data.ByteString.Char8      as BS
+import qualified Data.HashMap.Strict        as M
+import qualified Data.Set                   as S
 import qualified Hasql.Pool                 as P
+import qualified Hasql.Transaction          as H
 import qualified Hasql.Transaction          as HT
 import qualified Hasql.Transaction.Sessions as HT
 
-import           Network.HTTP.Types.Header
-import           Network.HTTP.Types.Status
-import           Network.HTTP.Types.URI    (renderSimpleQuery)
-import           Network.Wai
-import           Network.Wai.Middleware.RequestLogger (logStdout)
+import Data.Aeson                           as JSON
+import Data.Function                        (id)
+import Data.IORef                           (IORef, readIORef)
+import Data.Time.Clock                      (UTCTime)
+import Network.HTTP.Types.URI               (renderSimpleQuery)
+import Network.Wai.Middleware.RequestLogger (logStdout)
 
-import qualified Hasql.Transaction         as H
+import Control.Applicative
+import Data.Maybe
+import Network.HTTP.Types.Header
+import Network.HTTP.Types.Status
+import Network.Wai
 
-import qualified Data.HashMap.Strict       as M
-
-import           PostgREST.ApiRequest   ( ApiRequest(..), ContentType(..)
-                                        , Action(..), Target(..)
-                                        , PreferRepresentation (..)
-                                        , mutuallyAgreeable
-                                        , userApiRequest
-                                        )
-import           PostgREST.Auth            (jwtClaims, containsRole, parseSecret)
-import           PostgREST.Config          (AppConfig (..))
-import           PostgREST.DbStructure
-import           PostgREST.DbRequestBuilder( readRequest
-                                           , mutateRequest
-                                           , fieldNames
-                                           )
-import           PostgREST.Error           ( simpleError, pgError
-                                           , apiRequestError
-                                           , singularityError, binaryFieldError
-                                           , connectionLostError, gucHeadersError
-                                           )
-import           PostgREST.RangeQuery      (allRange, rangeOffset)
-import           PostgREST.Middleware
-import           PostgREST.QueryBuilder ( callProc
-                                        , requestToQuery
-                                        , requestToCountQuery
-                                        , createReadStatement
-                                        , createWriteStatement
-                                        , ResultsWithCount
-                                        )
-import           PostgREST.Types
-import           PostgREST.OpenAPI
-
-import           Data.Function (id)
-import           Protolude              hiding (intercalate, Proxy)
+import PostgREST.ApiRequest       (Action (..), ApiRequest (..),
+                                   ContentType (..),
+                                   PreferRepresentation (..),
+                                   Target (..), mutuallyAgreeable,
+                                   userApiRequest)
+import PostgREST.Auth             (containsRole, jwtClaims,
+                                   parseSecret)
+import PostgREST.Config           (AppConfig (..))
+import PostgREST.DbRequestBuilder (fieldNames, mutateRequest,
+                                   readRequest)
+import PostgREST.DbStructure
+import PostgREST.Error            (PgError (..), SimpleError (..),
+                                   errorResponseFor, singularityError)
+import PostgREST.Middleware
+import PostgREST.OpenAPI
+import PostgREST.Parsers          (pRequestColumns)
+import PostgREST.QueryBuilder     (ResultsWithCount, callProc,
+                                   createReadStatement,
+                                   createWriteStatement,
+                                   requestToCountQuery,
+                                   requestToQuery)
+import PostgREST.RangeQuery       (allRange, rangeOffset)
+import PostgREST.Types
+import Protolude                  hiding (Proxy, intercalate)
 
 postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> IO () -> Application
 postgrest conf refDbStructure pool getTime worker =
@@ -72,36 +62,31 @@ postgrest conf refDbStructure pool getTime worker =
     body <- strictRequestBody req
     maybeDbStructure <- readIORef refDbStructure
     case maybeDbStructure of
-      Nothing -> respond connectionLostError
+      Nothing -> respond . errorResponseFor $ ConnectionLostError
       Just dbStructure -> do
-        response <- case userApiRequest (configSchema conf) req body of
-          Left err -> return $ apiRequestError err
-          Right apiRequest -> do
-            eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) time (rightToMaybe $ configRoleClaimKey conf)
-
-            let authed = containsRole eClaims
-                proc = case (iTarget apiRequest, iPayload apiRequest, iPreferSingleObjectParameter apiRequest) of
-                  (TargetProc qi, Just PayloadJSON{pjKeys}, s) -> findProc qi pjKeys s $ dbProcs dbStructure
-                  _ -> Nothing
-                handleReq = runWithClaims conf eClaims (app dbStructure proc conf) apiRequest
-                txMode = transactionMode proc (iAction apiRequest)
-            response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq
-            return $ either (pgError authed) identity response
+        response <- do
+          -- Need to parse ?columns early because findProc needs it to solve overloaded functions
+          let apiReq = userApiRequest (configSchema conf) (configRootSpec conf) req body
+              apiReqCols = (,) <$> apiReq <*> (pRequestColumns =<< iColumns <$> apiReq)
+          case apiReqCols of
+            Left err -> return . errorResponseFor $ err
+            Right (apiRequest, maybeCols) -> do
+              eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) time (rightToMaybe $ configRoleClaimKey conf)
+              let authed = containsRole eClaims
+                  cols = case (iPayload apiRequest, maybeCols) of
+                    (Just ProcessedJSON{pjKeys}, _) -> pjKeys
+                    (Just RawJSON{}, Just cls)      -> cls
+                    _                               -> S.empty
+                  proc = case iTarget apiRequest of
+                    TargetProc qi _ -> findProc qi cols (iPreferSingleObjectParameter apiRequest) $ dbProcs dbStructure
+                    _ -> Nothing
+                  handleReq = runWithClaims conf eClaims (app dbStructure proc cols conf) apiRequest
+                  txMode = transactionMode proc (iAction apiRequest)
+              response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq
+              return $ either (errorResponseFor . PgError authed) identity response
         when (responseStatus response == status503) worker
         respond response
 
-findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> M.HashMap Text [ProcDescription] -> Maybe ProcDescription
-findProc qi payloadKeys paramsAsSingleObject allProcs =
-  let procs = M.lookup (qiName qi) allProcs in
- -- Handle overloaded functions case
-  join $ (case length <$> procs of
-    Just 1 -> headMay -- if it's not an overloaded function then immediatly get the ProcDescription
-    _ -> find (\x ->
-           if paramsAsSingleObject
-             then length (pdArgs x) == 1 -- if the arg is not of json type let the db give the err
-             else payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> pdArgs x))
-  ) <$> procs
-
 transactionMode :: Maybe ProcDescription -> Action -> HT.Mode
 transactionMode proc action =
   case action of
@@ -109,16 +94,16 @@ transactionMode proc action =
     ActionInfo -> HT.Read
     ActionInspect -> HT.Read
     ActionInvoke{isReadOnly=False} ->
-      let v = maybe Volatile  pdVolatility proc in
+      let v = maybe Volatile pdVolatility proc in
       if v == Stable || v == Immutable
          then HT.Read
          else HT.Write
     ActionInvoke{isReadOnly=True} -> HT.Read
     _ -> HT.Write
 
-app :: DbStructure -> Maybe ProcDescription -> AppConfig -> ApiRequest -> H.Transaction Response
-app dbStructure proc conf apiRequest =
-  case responseContentTypeOrError (iAccepts apiRequest) (iAction apiRequest) of
+app :: DbStructure -> Maybe ProcDescription -> S.Set FieldName -> AppConfig -> ApiRequest -> H.Transaction Response
+app dbStructure proc cols conf apiRequest =
+  case responseContentTypeOrError (iAccepts apiRequest) (iAction apiRequest) (iTarget apiRequest) of
     Left errorResponse -> return errorResponse
     Right contentType ->
       case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
@@ -137,7 +122,7 @@ app dbStructure proc conf apiRequest =
                   canonical = iCanonicalQS apiRequest
               return $
                 if contentType == CTSingularJSON && queryTotal /= 1
-                  then singularityError (toInteger queryTotal)
+                  then errorResponseFor . singularityError $ queryTotal
                   else responseLBS status
                     [toHeader contentType, contentRange,
                       ("Content-Location",
@@ -146,83 +131,86 @@ app dbStructure proc conf apiRequest =
                       )
                     ] (toS body)
 
-        (ActionCreate, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw, pjType}) ->
+        (ActionCreate, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
           case mutateSqlParts tSchema tName of
             Left errorResponse -> return errorResponse
             Right (sq, mq) -> do
-              let (isSingle, nRows) = case pjType of
-                                        PJArray len -> (len == 1, len)
-                                        PJObject -> (True, 1)
-              if contentType == CTSingularJSON
-                 && not isSingle
-                 && iPreferRepresentation apiRequest == Full
-                then return $ singularityError (toInteger nRows)
-                else do
-                  let pkCols = tablePKCols dbStructure tSchema tName
-                      stm = createWriteStatement sq mq
-                        (contentType == CTSingularJSON) isSingle
-                        (contentType == CTTextCSV) (iPreferRepresentation apiRequest) pkCols
-                  row <- H.statement (toS pjRaw) stm
-                  let (_, _, fs, body) = extractQueryResult row
-                      headers = catMaybes [
-                          if null fs
-                            then Nothing
-                            else Just (hLocation, "/" <> toS tName <> renderLocationFields fs)
-                        , if iPreferRepresentation apiRequest == Full
-                            then Just $ toHeader contentType
-                            else Nothing
-                        , Just . contentRangeH 1 0 $
-                            toInteger <$> if shouldCount then Just nRows else Nothing
-                        , if null pkCols
-                            then Nothing
-                            else (\x -> ("Preference-Applied", show x)) <$> iPreferResolution apiRequest
-                        ]
-
-                  return . responseLBS status201 headers $
-                    if iPreferRepresentation apiRequest == Full
-                      then toS body else ""
-
-        (ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just p@PayloadJSON{pjRaw}) ->
-          case (mutateSqlParts tSchema tName, pjIsEmpty p, iPreferRepresentation apiRequest == Full) of
-            (Left errorResponse, _, _) -> return errorResponse
-            (_, True, True) -> return $ responseLBS status200 [contentRangeH 1 0 Nothing] "[]"
-            (_, True, False) -> return $ responseLBS status204 [contentRangeH 1 0 Nothing] ""
-            (Right (sq, mq), _, _) -> do
-              let stm = createWriteStatement sq mq
-                    (contentType == CTSingularJSON) False (contentType == CTTextCSV)
-                    (iPreferRepresentation apiRequest) []
-              row <- H.statement (toS pjRaw) stm
-              let (_, queryTotal, _, body) = extractQueryResult row
+              let pkCols = tablePKCols dbStructure tSchema tName
+                  stm = createWriteStatement sq mq
+                    (contentType == CTSingularJSON) True
+                    (contentType == CTTextCSV) (iPreferRepresentation apiRequest) pkCols
+              row <- H.statement (toS $ pjRaw pJson) stm
+              let (_, queryTotal, fs, body) = extractQueryResult row
+                  headers = catMaybes [
+                      if null fs
+                        then Nothing
+                        else Just (hLocation, "/" <> toS tName <> renderLocationFields fs)
+                    , if iPreferRepresentation apiRequest == Full
+                        then Just $ toHeader contentType
+                        else Nothing
+                    , Just $ contentRangeH 1 0 $
+                        if shouldCount then Just queryTotal else Nothing
+                    , if null pkCols
+                        then Nothing
+                        else (\x -> ("Preference-Applied", show x)) <$> iPreferResolution apiRequest
+                    ]
               if contentType == CTSingularJSON
                  && queryTotal /= 1
                  && iPreferRepresentation apiRequest == Full
                 then do
                   HT.condemn
-                  return $ singularityError (toInteger queryTotal)
-                else do
-                  let r = contentRangeH 0 (toInteger $ queryTotal-1)
-                            (toInteger <$> if shouldCount then Just queryTotal else Nothing)
-                      s = if iPreferRepresentation apiRequest == Full
-                            then status200
-                            else status204
-                  return $ if iPreferRepresentation apiRequest == Full
-                    then responseLBS s [toHeader contentType, r] (toS body)
-                    else responseLBS s [r] ""
+                  return . errorResponseFor . singularityError $ queryTotal
+              else
+                return . responseLBS status201 headers $
+                  if iPreferRepresentation apiRequest == Full
+                    then toS body else ""
 
-        (ActionSingleUpsert, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw, pjType, pjKeys}) ->
+        (ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
+          case mutateSqlParts tSchema tName of
+            Left errorResponse -> return errorResponse
+            Right (sq, mq) -> do
+              let stm = createWriteStatement sq mq
+                    (contentType == CTSingularJSON) False (contentType == CTTextCSV)
+                    (iPreferRepresentation apiRequest) []
+              row <- H.statement (toS $ pjRaw pJson) stm
+              let (_, queryTotal, _, body) = extractQueryResult row
+
+                  updateIsNoOp       = S.null cols
+                  contentRangeHeader = contentRangeH 0 (queryTotal - 1) $
+                                          if shouldCount then Just queryTotal else Nothing
+                  minimalHeaders     = [contentRangeHeader]
+                  fullHeaders        = toHeader contentType : minimalHeaders
+
+                  status | queryTotal == 0 && not updateIsNoOp      = status404
+                         | iPreferRepresentation apiRequest == Full = status200
+                         | otherwise                                = status204
+
+              case (contentType, iPreferRepresentation apiRequest) of
+                (CTSingularJSON, Full)
+                      | queryTotal == 1 -> return $ responseLBS status fullHeaders (toS body)
+                      | otherwise       -> HT.condemn >> (return . errorResponseFor . singularityError) queryTotal
+
+                (_, Full) ->
+                  return $ responseLBS status fullHeaders (toS body)
+
+                (_, _) ->
+                  return $ responseLBS status minimalHeaders mempty
+
+
+        (ActionSingleUpsert, TargetIdent (QualifiedIdentifier tSchema tName), Just ProcessedJSON{pjRaw, pjType, pjKeys}) ->
           case mutateSqlParts tSchema tName of
             Left errorResponse -> return errorResponse
             Right (sq, mq) -> do
               let isSingle = case pjType of
                                PJArray len -> len == 1
-                               PJObject -> True
+                               PJObject    -> True
                   colNames = colName <$> tableCols dbStructure tSchema tName
               if topLevelRange /= allRange
-                then return $ simpleError status400 [] "Range header and limit/offset querystring parameters are not allowed for PUT"
+                then return . errorResponseFor $ PutRangeNotAllowedError
               else if not isSingle
-                then return $ simpleError status400 [] "PUT payload must contain a single row"
+                then return . errorResponseFor $ PutSingletonError
               else if S.fromList colNames /= pjKeys
-                then return $ simpleError status400 [] "You must specify all columns in the payload when using PUT"
+                then return . errorResponseFor $ PutPayloadIncompleteError
               else do
                 row <- H.statement (toS pjRaw) $
                        createWriteStatement sq mq (contentType == CTSingularJSON) False
@@ -234,7 +222,7 @@ app dbStructure proc conf apiRequest =
                 if queryTotal /= 1
                   then do
                     HT.condemn
-                    return $ simpleError status400 [] "Payload values do not match URL in primary key column(s)"
+                    return . errorResponseFor $ PutMatchingPkError
                   else
                     return $ if iPreferRepresentation apiRequest == Full
                       then responseLBS status200 [toHeader contentType] (toS body)
@@ -251,13 +239,13 @@ app dbStructure proc conf apiRequest =
               row <- H.statement mempty stm
               let (_, queryTotal, _, body) = extractQueryResult row
                   r = contentRangeH 1 0 $
-                        toInteger <$> if shouldCount then Just queryTotal else Nothing
+                        if shouldCount then Just queryTotal else Nothing
               if contentType == CTSingularJSON
                  && queryTotal /= 1
                  && iPreferRepresentation apiRequest == Full
                 then do
                   HT.condemn
-                  return $ singularityError (toInteger queryTotal)
+                  return . errorResponseFor . singularityError $ queryTotal
                 else
                   return $ if iPreferRepresentation apiRequest == Full
                     then responseLBS status200 [toHeader contentType, r] (toS body)
@@ -271,7 +259,7 @@ app dbStructure proc conf apiRequest =
               let acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
               return $ responseLBS status200 [allOrigins, acceptH] ""
 
-        (ActionInvoke _, TargetProc qi, Just PayloadJSON{pjRaw, pjType, pjKeys}) ->
+        (ActionInvoke _, TargetProc qi _, Just pJson) ->
           let returnsScalar = case proc of
                 Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
                 _ -> False
@@ -282,31 +270,27 @@ app dbStructure proc conf apiRequest =
           case parts of
             Left errorResponse -> return errorResponse
             Right ((q, cq), bField) -> do
-              let isObject = case pjType of
-                                PJObject  -> True
-                                PJArray _ -> False
-                  singular = contentType == CTSingularJSON
-                  specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ maybe [] pdArgs proc
-              row <- H.statement (toS pjRaw) $
-                callProc qi specifiedPgArgs returnsScalar q cq shouldCount
+              let singular = contentType == CTSingularJSON
+              row <- H.statement (toS $ pjRaw pJson) $
+                callProc qi (specifiedProcArgs cols proc) returnsScalar q cq shouldCount
                          singular (iPreferSingleObjectParameter apiRequest)
                          (contentType == CTTextCSV)
-                         (contentType == CTOctetStream) bField isObject
+                         (contentType `elem` rawContentTypes) bField
                          (pgVersion dbStructure)
               let (tableTotal, queryTotal, body, jsonHeaders) =
                     fromMaybe (Just 0, 0, "[]", "[]") row
                   (status, contentRange) = rangeHeader queryTotal tableTotal
                   decodedHeaders = first toS $ JSON.eitherDecode $ toS jsonHeaders :: Either Text [GucHeader]
               case decodedHeaders of
-                Left _ -> return gucHeadersError
+                Left _ -> return . errorResponseFor $ GucHeadersError
                 Right hs ->
                   if singular && queryTotal /= 1
                     then do
                       HT.condemn
-                      return $ singularityError (toInteger queryTotal)
+                      return . errorResponseFor . singularityError $ queryTotal
                     else return $ responseLBS status ([toHeader contentType, contentRange] ++ toHeaders hs) (toS body)
 
-        (ActionInspect, TargetRoot, Nothing) -> do
+        (ActionInspect, TargetDefaultSpec, Nothing) -> do
           let host = configHost conf
               port = toInteger $ configPort conf
               proxy = pickProxy $ toS <$> configProxyUri conf
@@ -316,6 +300,7 @@ app dbStructure proc conf apiRequest =
               toTableInfo :: [Table] -> [(Table, [Column], [Text])]
               toTableInfo = map (\t -> let (s, tn) = (tableSchema t, tableName t) in (t, tableCols dbStructure s tn, tablePKCols dbStructure s tn))
               encodeApi ti sd procs = encodeOpenAPI (concat $ M.elems procs) (toTableInfo ti) uri' sd $ dbPrimaryKeys dbStructure
+
           body <- encodeApi <$> H.statement schema accessibleTables <*> H.statement schema schemaDescription <*> H.statement schema accessibleProcs
           return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
 
@@ -340,39 +325,41 @@ app dbStructure proc conf apiRequest =
       selectQuery = requestToQuery schema False <$> readDbRequest
       countQuery = requestToCountQuery schema <$> readDbRequest
       readSqlParts = (,) <$> selectQuery <*> countQuery
+      mutationDbRequest s t = mutateRequest apiRequest t cols (tablePKCols dbStructure s t) =<< fldNames
       mutateSqlParts s t =
         (,) <$> selectQuery
-            <*> (requestToQuery schema False . DbMutate <$> (mutateRequest apiRequest t (tablePKCols dbStructure s t) =<< fldNames))
+            <*> (requestToQuery schema False . DbMutate <$> mutationDbRequest s t)
 
-responseContentTypeOrError :: [ContentType] -> Action -> Either Response ContentType
-responseContentTypeOrError accepts action = serves contentTypesForRequest accepts
+responseContentTypeOrError :: [ContentType] -> Action -> Target -> Either Response ContentType
+responseContentTypeOrError accepts action target = serves contentTypesForRequest accepts
   where
-    contentTypesForRequest =
-      case action of
-        ActionRead ->    [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
-        ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionInvoke _ ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
-        ActionInspect -> [CTOpenAPI, CTApplicationJSON]
-        ActionInfo ->    [CTTextCSV]
-        ActionSingleUpsert ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+    contentTypesForRequest = case action of
+      ActionRead         ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV] ++ rawContentTypes
+      ActionCreate       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionUpdate       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionDelete       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionInvoke _     ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV] ++ rawContentTypes ++
+                             [CTOpenAPI | tpIsRootSpec target]
+      ActionInspect      ->  [CTOpenAPI, CTApplicationJSON]
+      ActionInfo         ->  [CTTextCSV]
+      ActionSingleUpsert ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
     serves sProduces cAccepts =
       case mutuallyAgreeable sProduces cAccepts of
-        Nothing -> do
-          let failed = intercalate ", " $ map (toS . toMime) cAccepts
-          Left $ simpleError status415 [] $
-            "None of these Content-Types are available: " <> failed
+        Nothing -> Left . errorResponseFor . ContentTypeError . map toMime $ cAccepts
         Just ct -> Right ct
 
+{-
+  | If raw(binary) output is requested, check that ContentType is one of the admitted rawContentTypes and that
+  | `?select=...` contains only one field other than `*`
+-}
 binaryField :: ContentType -> [FieldName] -> Either Response (Maybe FieldName)
-binaryField CTOctetStream fldNames =
-  if length fldNames == 1 && fieldName /= Just "*"
-    then Right fieldName
-    else Left binaryFieldError
-  where
-    fieldName = headMay fldNames
-binaryField _ _ = Right Nothing
+binaryField ct fldNames
+  | ct `elem` rawContentTypes =
+      let fieldName = headMay fldNames in
+      if length fldNames == 1 && fieldName /= Just "*"
+        then Right fieldName
+        else Left . errorResponseFor $ BinaryFieldError ct
+  | otherwise = Right Nothing
 
 splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString)
 splitKeyValue kv = (k, BS.tail v)
@@ -389,7 +376,7 @@ rangeStatus lower upper (Just total)
   | (1 + upper - lower) < total = status206
   | otherwise               = status200
 
-contentRangeH :: Integer -> Integer -> Maybe Integer -> Header
+contentRangeH :: (Integral a, Show a) => a -> a -> Maybe a -> Header
 contentRangeH lower upper total =
     ("Content-Range", headerValue)
     where

src/PostgREST/Auth.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase       #-}
 {-|
 Module      : PostgREST.Auth
 Description : PostgREST authorization functions.
@@ -19,17 +19,19 @@ module PostgREST.Auth (
   , parseSecret
   ) where
 
-import           Control.Lens.Operators
-import           Control.Lens           (set)
-import qualified Data.Aeson             as JSON
-import qualified Data.HashMap.Strict    as M
-import           Data.Time.Clock        (UTCTime)
-import           Data.Vector            as V
-import           PostgREST.Types
-import           Protolude
+import qualified Crypto.JOSE.Types   as JOSE.Types
+import qualified Data.Aeson          as JSON
+import qualified Data.HashMap.Strict as M
+import           Data.Vector         as V
 
-import qualified Crypto.JOSE.Types      as JOSE.Types
-import           Crypto.JWT
+import Control.Lens    (set)
+import Data.Time.Clock (UTCTime)
+
+import Control.Lens.Operators
+import Crypto.JWT
+
+import PostgREST.Types
+import Protolude
 
 {-|
   Possible situations encountered with client JWTs

src/PostgREST/Config.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE LambdaCase, TemplateHaskell #-}
-{-# OPTIONS_GHC -fno-warn-type-defaults #-}
 {-|
 Module      : PostgREST.Config
 Description : Manages PostgREST configuration options.
@@ -14,51 +12,58 @@ turned in configurable behaviour if needed.
 
 Other hardcoded options such as the minimum version number also belong here.
 -}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+
 module PostgREST.Config ( prettyVersion
                         , docsVersion
                         , readOptions
                         , corsPolicy
                         , AppConfig (..)
+                        , configPoolTimeout'
                         )
        where
 
-import           Control.Applicative
-import           Control.Monad                (fail)
-import           Control.Lens                 (preview)
-import           Crypto.JWT                   (StringOrURI,
-                                               stringOrUri)
 import qualified Data.ByteString              as B
 import qualified Data.ByteString.Char8        as BS
 import qualified Data.CaseInsensitive         as CI
 import qualified Data.Configurator            as C
-import qualified Data.Configurator.Parser     as C
-import           Data.Configurator.Types      as C
-import           Data.List                    (lookup)
-import           Data.Monoid
-import           Data.Scientific              (floatingOrInteger)
-import           Data.String                  (String)
-import           Data.Text                    (dropAround,
-                                               intercalate, lines,
-                                               strip, take, splitOn)
-import           Data.Text.Encoding           (encodeUtf8)
-import           Data.Text.IO                 (hPutStrLn)
-import           Data.Version                 (versionBranch)
-import           Development.GitRev           (gitHash)
-import           Network.Wai
-import           Network.Wai.Middleware.Cors  (CorsResourcePolicy (..))
-import           Options.Applicative          hiding (str)
-import           Paths_postgrest              (version)
-import           PostgREST.Parsers            (pRoleClaimKey)
-import           PostgREST.Types              (ApiRequestError(..),
-                                               JSPath, JSPathExp(..))
-import           Protolude                    hiding (hPutStrLn, take,
-                                               intercalate, (<>))
-import           System.IO                    (hPrint)
-import           System.IO.Error              (IOError)
-import           Text.Heredoc
-import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
 import qualified Text.PrettyPrint.ANSI.Leijen as L
 
+import Control.Exception           (Handler (..))
+import Control.Lens                (preview)
+import Control.Monad               (fail)
+import Crypto.JWT                  (StringOrURI, stringOrUri)
+import Data.List                   (lookup)
+import Data.Scientific             (floatingOrInteger)
+import Data.Text                   (dropEnd, dropWhileEnd,
+                                    intercalate, lines, splitOn,
+                                    strip, take, unpack)
+import Data.Text.Encoding          (encodeUtf8)
+import Data.Text.IO                (hPutStrLn)
+import Data.Version                (versionBranch)
+import Development.GitRev          (gitHash)
+import Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
+import Paths_postgrest             (version)
+import System.IO.Error             (IOError)
+
+import Control.Applicative
+import Data.Monoid
+import Network.Wai
+import Options.Applicative          hiding (str)
+import Text.Heredoc
+import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
+
+import PostgREST.Error   (ApiRequestError (..))
+import PostgREST.Parsers (pRoleClaimKey)
+import PostgREST.Types   (JSPath, JSPathExp (..),
+                          QualifiedIdentifier (..))
+import Protolude         hiding (concat, hPutStrLn, intercalate, null,
+                          take, (<>))
+
+
 -- | Config file settings for the server
 data AppConfig = AppConfig {
     configDatabase          :: Text
@@ -67,20 +72,29 @@ data AppConfig = AppConfig {
   , configSchema            :: Text
   , configHost              :: Text
   , configPort              :: Int
+  , configSocket            :: Maybe Text
 
   , configJwtSecret         :: Maybe B.ByteString
   , configJwtSecretIsBase64 :: Bool
   , configJwtAudience       :: Maybe StringOrURI
 
   , configPool              :: Int
+  , configPoolTimeout       :: Int
   , configMaxRows           :: Maybe Integer
   , configReqCheck          :: Maybe Text
   , configQuiet             :: Bool
   , configSettings          :: [(Text, Text)]
   , configRoleClaimKey      :: Either ApiRequestError JSPath
   , configExtraSearchPath   :: [Text]
+
+  , configRootSpec          :: Maybe QualifiedIdentifier
   }
 
+configPoolTimeout' :: (Fractional a) => AppConfig -> a
+configPoolTimeout' =
+  fromRational . toRational . configPoolTimeout
+
+
 defaultCorsPolicy :: CorsResourcePolicy
 defaultCorsPolicy =  CorsResourcePolicy Nothing
   ["GET", "POST", "PATCH", "PUT", "DELETE", "OPTIONS"] ["Authorization"] Nothing
@@ -112,7 +126,7 @@ prettyVersion =
 
 -- | Version number used in docs
 docsVersion :: Text
-docsVersion = "v" <> dropAround (== '.') (dropAround (/= '.') prettyVersion)
+docsVersion = "v" <> dropEnd 1 (dropWhileEnd (/= '.') prettyVersion)
 
 -- | Function to read and parse options from the command line
 readOptions :: IO AppConfig
@@ -120,67 +134,86 @@ readOptions = do
   -- First read the config file path from command line
   cfgPath <- customExecParser parserPrefs opts
   -- Now read the actual config file
-  conf <- catch
-    (C.readConfig =<< C.load [C.Required cfgPath])
-    configNotfoundHint
+  conf <- catches (C.load cfgPath)
+    [ Handler (\(ex :: IOError)    -> exitErr $ "Cannot open config file:\n\t" <> show ex)
+    , Handler (\(C.ParseError err) -> exitErr $ "Error parsing config file:\n\t" <> err)
+    ]
 
-  let (mAppConf, errs) = flip C.runParserM conf $
-        AppConfig
-          <$> C.key "db-uri"
-          <*> C.key "db-anon-role"
-          <*> (mfilter (/= "") <$> C.key "server-proxy-uri")
-          <*> C.key "db-schema"
-          <*> (fromMaybe "127.0.0.1" . mfilter (/= "") <$> C.key "server-host")
-          <*> (fromMaybe 3000 . join . fmap coerceInt <$> C.key "server-port")
-          <*> (fmap encodeUtf8 . mfilter (/= "") <$> C.key "jwt-secret")
-          <*> (fromMaybe False . join . fmap coerceBool <$> C.key "secret-is-base64")
-          <*> parseJwtAudience "jwt-aud"
-          <*> (fromMaybe 10 . join . fmap coerceInt <$> C.key "db-pool")
-          <*> (join . fmap coerceInt <$> C.key "max-rows")
-          <*> (mfilter (/= "") <$> C.key "pre-request")
-          <*> pure False
-          <*> (fmap (fmap coerceText) <$> C.subassocs "app.settings")
-          <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> C.key "role-claim-key")
-          <*> (maybe ["public"] splitExtraSearchPath <$> C.key "db-extra-search-path")
-
-  case mAppConf of
-    Nothing -> do
-      forM_ errs $ hPrint stderr
-      exitFailure
-    Just appConf ->
+  case C.runParser parseConfig conf of
+    Left err ->
+      exitErr $ "Error parsing config file:\n\t" <> err
+    Right appConf ->
       return appConf
 
   where
-    parseJwtAudience :: Name -> C.ConfigParserM (Maybe StringOrURI)
+    dbSchema = reqString "db-schema"
+    parseConfig =
+      AppConfig
+        <$> reqString "db-uri"
+        <*> reqString "db-anon-role"
+        <*> optString "server-proxy-uri"
+        <*> dbSchema
+        <*> (fromMaybe "!4" <$> optString "server-host")
+        <*> (fromMaybe 3000 <$> optInt "server-port")
+        <*> optString "server-unix-socket"
+        <*> (fmap encodeUtf8 <$> optString "jwt-secret")
+        <*> (fromMaybe False <$> optBool "secret-is-base64")
+        <*> parseJwtAudience "jwt-aud"
+        <*> (fromMaybe 10 <$> optInt "db-pool")
+        <*> (fromMaybe 10 <$> optInt "db-pool-timeout")
+        <*> optInt "max-rows"
+        <*> optString "pre-request"
+        <*> pure False
+        <*> (fmap (fmap coerceText) <$> C.subassocs "app.settings" C.value)
+        <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> optValue "role-claim-key")
+        <*> (maybe ["public"] splitExtraSearchPath <$> optValue "db-extra-search-path")
+        <*> ((\x y -> QualifiedIdentifier x <$> y) <$> dbSchema <*> optString "root-spec")
+
+    parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI)
     parseJwtAudience k =
-      C.key k >>= \case
+      C.optional k C.string >>= \case
         Nothing -> pure Nothing -- no audience in config file
-        Just aud -> case preview stringOrUri (aud :: String) of
+        Just aud -> case preview stringOrUri (unpack aud) of
           Nothing -> fail "Invalid Jwt audience. Check your configuration."
           (Just "") -> pure Nothing
           aud' -> pure aud'
 
-    coerceText :: Value -> Text
-    coerceText (String s) = s
-    coerceText v = show v
+    reqString :: C.Key -> C.Parser C.Config Text
+    reqString k = C.required k C.string
 
-    coerceInt :: (Read i, Integral i) => Value -> Maybe i
-    coerceInt (Number x) = rightToMaybe $ floatingOrInteger x
-    coerceInt (String x) = readMaybe $ toS x
-    coerceInt _          = Nothing
+    optString :: C.Key -> C.Parser C.Config (Maybe Text)
+    optString k = mfilter (/= "") <$> C.optional k C.string
 
-    coerceBool :: Value -> Maybe Bool
-    coerceBool (Bool b)   = Just b
-    coerceBool (String b) = readMaybe $ toS b
-    coerceBool _          = Nothing
+    optValue :: C.Key -> C.Parser C.Config (Maybe C.Value)
+    optValue k = C.optional k C.value
 
-    parseRoleClaimKey :: Value -> Either ApiRequestError JSPath
-    parseRoleClaimKey (String s) = pRoleClaimKey s
-    parseRoleClaimKey v = pRoleClaimKey $ show v
+    optInt :: (Read i, Integral i) => C.Key -> C.Parser C.Config (Maybe i)
+    optInt k = join <$> C.optional k (coerceInt <$> C.value)
 
-    splitExtraSearchPath :: Value -> [Text]
-    splitExtraSearchPath (String s) = strip <$> splitOn "," s
-    splitExtraSearchPath _ = []
+    optBool :: C.Key -> C.Parser C.Config (Maybe Bool)
+    optBool k = join <$> C.optional k (coerceBool <$> C.value)
+
+    coerceText :: C.Value -> Text
+    coerceText (C.String s) = s
+    coerceText v            = show v
+
+    coerceInt :: (Read i, Integral i) => C.Value -> Maybe i
+    coerceInt (C.Number x) = rightToMaybe $ floatingOrInteger x
+    coerceInt (C.String x) = readMaybe $ toS x
+    coerceInt _            = Nothing
+
+    coerceBool :: C.Value -> Maybe Bool
+    coerceBool (C.Bool b)   = Just b
+    coerceBool (C.String b) = readMaybe $ toS b
+    coerceBool _            = Nothing
+
+    parseRoleClaimKey :: C.Value -> Either ApiRequestError JSPath
+    parseRoleClaimKey (C.String s) = pRoleClaimKey s
+    parseRoleClaimKey v            = pRoleClaimKey $ show v
+
+    splitExtraSearchPath :: C.Value -> [Text]
+    splitExtraSearchPath (C.String s) = strip <$> splitOn "," s
+    splitExtraSearchPath _            = []
 
     opts = info (helper <*> pathParser) $
              fullDesc
@@ -196,10 +229,9 @@ readOptions = do
 
     parserPrefs = prefs showHelpOnError
 
-    configNotfoundHint :: IOError -> IO a
-    configNotfoundHint e = do
-      hPutStrLn stderr $
-        "Cannot open config file:\n\t" <> show e
+    exitErr :: Text -> IO a
+    exitErr err = do
+      hPutStrLn stderr err
       exitFailure
 
     exampleCfg :: Doc
@@ -208,10 +240,15 @@ readOptions = do
           |db-schema = "public" # this schema gets added to the search_path of every request
           |db-anon-role = "postgres"
           |db-pool = 10
+          |db-pool-timeout = 10
           |
-          |server-host = "127.0.0.1"
+          |server-host = "!4"
           |server-port = 3000
           |
+          |## unix socket location
+          |## if specified it takes precedence over server-port
+          |# server-unix-socket = "/tmp/pgrst.sock"
+          |
           |## base url for swagger output
           |# server-proxy-uri = ""
           |
@@ -232,6 +269,10 @@ readOptions = do
           |
           |## extra schemas to add to the search_path of every request
           |# db-extra-search-path = "extensions, util"
+          |
+          |## stored proc that overrides the root "/" spec
+          |## it must be inside the db-schema
+          |# root-spec = "stored_proc_name"
           |]
 
 pathParser :: Parser FilePath

src/PostgREST/DbRequestBuilder.hs

@@ -1,48 +1,53 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE DuplicateRecordFields#-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-|
+Module      : PostgREST.DbRequestBuilder
+Description : PostgREST database request builder
+
+This module is in charge of building an intermediate representation(ReadRequest, MutateRequest) between the HTTP request and the final resulting SQL query.
+
+A query tree is built in case of resource embedding. By inferring the relationship between tables, join conditions are added for every embedded resource.
+-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE NamedFieldPuns        #-}
+
 module PostgREST.DbRequestBuilder (
   readRequest
 , mutateRequest
 , fieldNames
 ) where
 
-import           Control.Applicative
-import           Control.Arrow             ((***))
-import           Control.Lens.Getter       (view)
-import           Control.Lens.Tuple        (_1)
-import qualified Data.ByteString.Char8     as BS
-import           Data.List                 (delete)
-import           Data.Maybe                (fromJust)
-import qualified Data.Set                  as S
-import           Data.Text                 (isInfixOf)
-import           Data.Tree
-import           Data.Either.Combinators   (mapLeft)
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.HashMap.Strict   as M
+import qualified Data.Set              as S
 
-import           Network.Wai
+import Control.Arrow           ((***))
+import Control.Lens.Getter     (view)
+import Control.Lens.Tuple      (_1)
+import Data.Either.Combinators (mapLeft)
+import Data.Foldable           (foldr1)
+import Data.List               (delete)
+import Data.Maybe              (fromJust)
+import Data.Text               (isInfixOf)
+import Text.Regex.TDFA         ((=~))
+import Unsafe                  (unsafeHead)
 
-import           Data.Foldable (foldr1)
-import qualified Data.HashMap.Strict       as M
+import Control.Applicative
+import Data.Tree
+import Network.Wai
 
-import           PostgREST.ApiRequest   ( ApiRequest(..)
-                                        , PreferRepresentation(..)
-                                        , Action(..), Target(..)
-                                        , PreferRepresentation (..)
-                                        )
-import           PostgREST.Error           (apiRequestError)
-import           PostgREST.Parsers
-import           PostgREST.RangeQuery      (NonnegRange, restrictRange, allRange)
-import           PostgREST.Types
-
-import           Protolude                hiding (from)
-import           Text.Regex.TDFA         ((=~))
-import           Unsafe                  (unsafeHead)
+import PostgREST.ApiRequest (Action (..), ApiRequest (..),
+                             PreferRepresentation (..),
+                             PreferRepresentation (..), Target (..))
+import PostgREST.Error      (ApiRequestError (..), errorResponseFor)
+import PostgREST.Parsers
+import PostgREST.RangeQuery (NonnegRange, allRange, restrictRange)
+import PostgREST.Types
+import Protolude            hiding (from)
 
 readRequest :: Maybe Integer -> [Relation] -> Maybe ProcDescription -> ApiRequest -> Either Response ReadRequest
 readRequest maxRows allRels proc apiRequest  =
-  mapLeft apiRequestError $
+  mapLeft errorResponseFor $
   treeRestrictRange maxRows =<<
   augumentRequestWithJoin schema relations =<<
   addFiltersOrdersRanges apiRequest <*>
@@ -53,12 +58,12 @@ readRequest maxRows allRels proc apiRequest  =
       let target = iTarget apiRequest in
       case target of
         (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
-        (TargetProc  (QualifiedIdentifier s pName) ) -> Just (s, tName)
+        (TargetProc  (QualifiedIdentifier s pName) _ ) -> Just (s, tName)
           where
             tName = case pdReturnType <$> proc of
-              Just (SetOf (Composite qi)) -> qiName qi
+              Just (SetOf (Composite qi))  -> qiName qi
               Just (Single (Composite qi)) -> qiName qi
-              _ -> pName
+              _                            -> pName
 
         _ -> Nothing
 
@@ -68,7 +73,7 @@ readRequest maxRows allRels proc apiRequest  =
     buildReadRequest fieldTree =
       let rootDepth = 0
           rootNodeName = if action == ActionRead then rootTableName else sourceCTEName in
-      foldr (treeEntry rootDepth) (Node (Select [] [rootNodeName] [] [] [] allRange, (rootNodeName, Nothing, Nothing, Nothing, rootDepth)) []) fieldTree
+      foldr (treeEntry rootDepth) (Node (Select [] rootNodeName Nothing [] [] [] [] allRange, (rootNodeName, Nothing, Nothing, Nothing, rootDepth)) []) fieldTree
       where
         treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
         treeEntry depth (Node fld@((fn, _),_,alias,relationDetail) fldForest) (Node (q, i) rForest) =
@@ -76,7 +81,7 @@ readRequest maxRows allRels proc apiRequest  =
           case fldForest of
             [] -> Node (q {select=fld:select q}, i) rForest
             _  -> Node (q, i) $
-                  foldr (treeEntry nxtDepth) (Node (Select [] [fn] [] [] [] allRange, (fn, Nothing, alias, relationDetail, nxtDepth)) []) fldForest:rForest
+                  foldr (treeEntry nxtDepth) (Node (Select [] fn Nothing [] [] [] [] allRange, (fn, Nothing, alias, relationDetail, nxtDepth)) []) fldForest:rForest
 
     relations :: [Relation]
     relations = case action of
@@ -84,7 +89,7 @@ readRequest maxRows allRels proc apiRequest  =
       ActionUpdate   -> fakeSourceRelations ++ allRels
       ActionDelete   -> fakeSourceRelations ++ allRels
       ActionInvoke _ -> fakeSourceRelations ++ allRels
-      _       -> allRels
+      _              -> allRels
       where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels
 
 -- in a relation where one of the tables matches "TableName"
@@ -108,13 +113,13 @@ treeRestrictRange maxRows_ request = pure $ nodeRestrictRange maxRows_ `fmap` re
 augumentRequestWithJoin :: Schema ->  [Relation] ->  ReadRequest -> Either ApiRequestError ReadRequest
 augumentRequestWithJoin schema allRels request =
   addRelations schema allRels Nothing request
-  >>= addJoinConditions schema
+  >>= addJoinConditions schema Nothing
 
 addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
-addRelations schema allRelations parentNode (Node (query, (nodeName, _, alias, relationDetail, depth)) forest) =
+addRelations schema allRelations parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, relationDetail, depth)) forest) =
   case parentNode of
-    Just (Node (Select{from=[parentNodeTable]}, _) _) ->
-      let newFrom r = (\tName -> if tName == nodeName then tableName (relTable r) else tName) <$> from query
+    Just (Node (Select{from=parentNodeTable}, _) _) ->
+      let newFrom r = if tbl == nodeName then tableName (relTable r) else tbl
           newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, Nothing, depth))) <$> rel
           rel :: Either ApiRequestError Relation
           rel = note (NoRelationBetween parentNodeTable nodeName) $
@@ -208,35 +213,49 @@ findRelation schema allRelations nodeTableName parentNodeTableName relationDetai
         )
   ) allRelations
 
-addJoinConditions :: Schema -> ReadRequest -> Either ApiRequestError ReadRequest
-addJoinConditions schema (Node node@(query, nodeProps@(_, relation, _, _, _)) forest) =
+-- previousAlias is only used for the case of self joins
+addJoinConditions :: Schema -> Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest
+addJoinConditions schema previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_, relation, _, _, depth)) forest) =
   case relation of
-    Just Relation{relType=Root} -> Node node  <$> updatedForest -- this is the root node
+    Just Relation{relType=Root} -> Node node <$> updatedForest -- this is the root node
     Just rel@Relation{relType=Parent} -> Node (augmentQuery rel, nodeProps) <$> updatedForest
     Just rel@Relation{relType=Child} -> Node (augmentQuery rel, nodeProps) <$> updatedForest
     Just rel@Relation{relType=Many, relLinkTable=(Just linkTable)} ->
       let rq = augmentQuery rel in
-      Node (rq{from=tableName linkTable:from rq}, nodeProps) <$> updatedForest
+      Node (rq{implicitJoins=tableName linkTable:implicitJoins rq}, nodeProps) <$> updatedForest
     _ -> Left UnknownRelation
   where
-    updatedForest = mapM (addJoinConditions schema) forest
-    augmentQuery rel = foldr addJoinCond query (getJoinConditions rel)
-    addJoinCond :: JoinCondition -> ReadQuery -> ReadQuery
-    addJoinCond jc rq@Select{joinConditions=jcs} = rq{joinConditions=jc:jcs}
+    newAlias = case isSelfJoin <$> relation of
+      Just True
+        | depth /= 0 -> Just (tbl <> "_" <> show depth) -- root node doesn't get aliased
+        | otherwise  -> Nothing
+      _              -> Nothing
+    augmentQuery rel =
+      foldr
+        (\jc rq@Select{joinConditions=jcs} -> rq{joinConditions=jc:jcs})
+        query{fromAlias=newAlias}
+        (getJoinConditions previousAlias newAlias rel)
+    updatedForest = mapM (addJoinConditions schema newAlias) forest
 
-getJoinConditions :: Relation -> [JoinCondition]
-getJoinConditions (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fCols typ lt lc1 lc2) =
-  if | typ == Child || typ == Parent ->
+-- previousAlias and newAlias are used in the case of self joins
+getJoinConditions :: Maybe Alias -> Maybe Alias -> Relation -> [JoinCondition]
+getJoinConditions previousAlias newAlias (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fCols typ lt lc1 lc2) =
+  case typ of
+    Child  ->
         zipWith (toJoinCondition tN ftN) cols fCols
-     | typ == Many ->
+    Parent ->
+        zipWith (toJoinCondition tN ftN) cols fCols
+    Many   ->
         let ltN = maybe "" tableName lt in
         zipWith (toJoinCondition tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toJoinCondition ftN ltN) fCols (fromMaybe [] lc2)
-     | typ == Root -> witness
+    Root   -> witness
   where
     toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition
     toJoinCondition tb ftb c fc =
-      JoinCondition (QualifiedIdentifier tSchema tb, Nothing, colName c)
-                    (QualifiedIdentifier tSchema ftb, Nothing, colName fc)
+      let qi1 = QualifiedIdentifier tSchema tb
+          qi2 = QualifiedIdentifier tSchema ftb in
+        JoinCondition (maybe qi1 (QualifiedIdentifier mempty) newAlias, colName c)
+                      (maybe qi2 (QualifiedIdentifier mempty) previousAlias, colName fc)
 
 addFiltersOrdersRanges :: ApiRequest -> Either ApiRequestError (ReadRequest -> ReadRequest)
 addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
@@ -299,11 +318,11 @@ addProperty f (targetNodeName:remainingPath, a) (Node rn forest) =
   where
     pathNode = find (\(Node (_,(nodeName,_,alias,_,_)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
 
-mutateRequest :: ApiRequest -> TableName -> [Text] -> [FieldName] -> Either Response MutateRequest
-mutateRequest apiRequest tName pkCols fldNames = mapLeft apiRequestError $
+mutateRequest :: ApiRequest -> TableName -> S.Set FieldName -> [FieldName] -> [FieldName] -> Either Response MutateRequest
+mutateRequest apiRequest tName cols pkCols fldNames = mapLeft errorResponseFor $
   case action of
-    ActionCreate -> Right $ Insert tName pkCols payload (iPreferResolution apiRequest) [] returnings
-    ActionUpdate -> Update tName payload <$> combinedLogic <*> pure returnings
+    ActionCreate -> Right $ Insert tName cols ((,) <$> iPreferResolution apiRequest <*> Just pkCols) [] returnings
+    ActionUpdate -> Update tName cols <$> combinedLogic <*> pure returnings
     ActionSingleUpsert ->
       (\flts ->
         if null (iLogic apiRequest) &&
@@ -312,14 +331,13 @@ mutateRequest apiRequest tName pkCols fldNames = mapLeft apiRequestError $
            all (\case
               Filter _ (OpExpr False (Op "eq" _)) -> True
               _ -> False) flts
-          then Insert tName pkCols payload (Just MergeDuplicates) <$> combinedLogic <*> pure returnings
+          then Insert tName cols (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
         else
           Left InvalidFilters) =<< filters
     ActionDelete -> Delete tName <$> combinedLogic <*> pure returnings
     _            -> Left UnsupportedVerb
   where
     action = iAction apiRequest
-    payload = fromJust $ iPayload apiRequest
     returnings = if iPreferRepresentation apiRequest == None then [] else fldNames
     filters = map snd <$> mapM pRequestFilter mutateFilters
     logic = map snd <$> mapM pRequestLogicTree logicFilters

src/PostgREST/DbStructure.hs

@@ -1,9 +1,19 @@
+{-|
+Module      : PostgREST.DbStructure
+Description : PostgREST schema cache
+
+This module contains queries that target PostgreSQL system catalogs, these are used to build the schema cache(DbStructure).
+
+The schema cache is necessary for resource embedding, foreign keys are used for inferring the relationships between tables.
+
+These queries are executed once at startup or when PostgREST is reloaded.
+-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns        #-}
 {-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
-{-# LANGUAGE NamedFieldPuns  #-}
 module PostgREST.DbStructure (
   getDbStructure
 , accessibleTables
@@ -12,26 +22,38 @@ module PostgREST.DbStructure (
 , getPgVersion
 ) where
 
-import qualified Hasql.Decoders                as HD
-import qualified Hasql.Encoders                as HE
-import qualified Hasql.Statement               as H
+import qualified Data.HashMap.Strict as M
+import qualified Data.List           as L
+import qualified Data.Text           as T
+import qualified Hasql.Decoders      as HD
+import qualified Hasql.Encoders      as HE
+import qualified Hasql.Session       as H
+import qualified Hasql.Statement     as H
+import qualified Hasql.Transaction   as HT
 
-import           Control.Applicative
-import qualified Data.HashMap.Strict           as M
-import qualified Data.List                     as L
-import           Data.Set                      as S (fromList)
-import           Data.Text                     (split, strip,
-                                                breakOn, dropAround,
-                                                splitOn)
-import qualified Data.Text                     as T
-import qualified Hasql.Session                 as H
-import qualified Hasql.Transaction             as HT
-import           PostgREST.Types
-import           Text.InterpolatedString.Perl6 (q, qc)
+import Data.Set                      as S (fromList)
+import Data.Text                     (breakOn, dropAround, split,
+                                      splitOn, strip)
+import GHC.Exts                      (groupWith)
+import Text.InterpolatedString.Perl6 (q, qc)
+import Unsafe                        (unsafeHead)
 
-import           GHC.Exts                      (groupWith)
-import           Protolude
-import           Unsafe (unsafeHead)
+import Control.Applicative
+
+import PostgREST.Types
+import Protolude
+
+column :: HD.Value a -> HD.Row a
+column = HD.column . HD.nonNullable
+
+nullableColumn :: HD.Value a -> HD.Row (Maybe a)
+nullableColumn = HD.column . HD.nullable
+
+element :: HD.Value a -> HD.Array a
+element = HD.element . HD.nonNullable
+
+param :: HE.Value a -> HE.Params a
+param = HE.param . HE.nonNullable
 
 getDbStructure :: Schema -> PgVersion -> HT.Transaction DbStructure
 getDbStructure schema pgVer = do
@@ -60,10 +82,10 @@ decodeTables :: HD.Result [Table]
 decodeTables =
   HD.rowList tblRow
  where
-  tblRow = Table <$> HD.column HD.text
-                 <*> HD.column HD.text
-                 <*> HD.nullableColumn HD.text
-                 <*> HD.column HD.bool
+  tblRow = Table <$> column HD.text
+                 <*> column HD.text
+                 <*> nullableColumn HD.text
+                 <*> column HD.bool
 
 decodeColumns :: [Table] -> HD.Result [Column]
 decodeColumns tables =
@@ -71,41 +93,41 @@ decodeColumns tables =
  where
   colRow =
     (,,,,,,,,,,,)
-      <$> HD.column HD.text <*> HD.column HD.text
-      <*> HD.column HD.text <*> HD.nullableColumn HD.text
-      <*> HD.column HD.int4 <*> HD.column HD.bool
-      <*> HD.column HD.text <*> HD.column HD.bool
-      <*> HD.nullableColumn HD.int4
-      <*> HD.nullableColumn HD.int4
-      <*> HD.nullableColumn HD.text
-      <*> HD.nullableColumn HD.text
+      <$> column HD.text <*> column HD.text
+      <*> column HD.text <*> nullableColumn HD.text
+      <*> column HD.int4 <*> column HD.bool
+      <*> column HD.text <*> column HD.bool
+      <*> nullableColumn HD.int4
+      <*> nullableColumn HD.int4
+      <*> nullableColumn HD.text
+      <*> nullableColumn HD.text
 
 decodeRelations :: [Table] -> [Column] -> HD.Result [Relation]
 decodeRelations tables cols =
   mapMaybe (relationFromRow tables cols) <$> HD.rowList relRow
  where
   relRow = (,,,,,)
-    <$> HD.column HD.text
-    <*> HD.column HD.text
-    <*> HD.column (HD.array (HD.dimension replicateM (HD.element HD.text)))
-    <*> HD.column HD.text
-    <*> HD.column HD.text
-    <*> HD.column (HD.array (HD.dimension replicateM (HD.element HD.text)))
+    <$> column HD.text
+    <*> column HD.text
+    <*> column (HD.array (HD.dimension replicateM (element HD.text)))
+    <*> column HD.text
+    <*> column HD.text
+    <*> column (HD.array (HD.dimension replicateM (element HD.text)))
 
 decodePks :: [Table] -> HD.Result [PrimaryKey]
 decodePks tables =
   mapMaybe (pkFromRow tables) <$> HD.rowList pkRow
  where
-  pkRow = (,,) <$> HD.column HD.text <*> HD.column HD.text <*> HD.column HD.text
+  pkRow = (,,) <$> column HD.text <*> column HD.text <*> column HD.text
 
 decodeSynonyms :: [Column] -> HD.Result [Synonym]
 decodeSynonyms cols =
   mapMaybe (synonymFromRow cols) <$> HD.rowList synRow
  where
   synRow = (,,,,,)
-    <$> HD.column HD.text <*> HD.column HD.text
-    <*> HD.column HD.text <*> HD.column HD.text
-    <*> HD.column HD.text <*> HD.column HD.text
+    <$> column HD.text <*> column HD.text
+    <*> column HD.text <*> column HD.text
+    <*> column HD.text <*> column HD.text
 
 decodeProcs :: HD.Result (M.HashMap Text [ProcDescription])
 decodeProcs =
@@ -113,15 +135,15 @@ decodeProcs =
   map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addName) <$> HD.rowList tblRow
   where
     tblRow = ProcDescription
-              <$> HD.column HD.text
-              <*> HD.nullableColumn HD.text
-              <*> (parseArgs <$> HD.column HD.text)
+              <$> column HD.text
+              <*> nullableColumn HD.text
+              <*> (parseArgs <$> column HD.text)
               <*> (parseRetType
-                  <$> HD.column HD.text
-                  <*> HD.column HD.text
-                  <*> HD.column HD.bool
-                  <*> HD.column HD.char)
-              <*> (parseVolatility <$> HD.column HD.char)
+                  <$> column HD.text
+                  <*> column HD.text
+                  <*> column HD.bool
+                  <*> column HD.char)
+              <*> (parseVolatility <$> column HD.char)
 
     addName :: ProcDescription -> (Text, ProcDescription)
     addName pd = (pdName pd, pd)
@@ -158,10 +180,10 @@ decodeProcs =
                       | otherwise = Volatile -- only 'v' can happen here
 
 allProcs :: H.Statement Schema (M.HashMap Text [ProcDescription])
-allProcs = H.Statement (toS procsSqlQuery) (HE.param HE.text) decodeProcs True
+allProcs = H.Statement (toS procsSqlQuery) (param HE.text) decodeProcs True
 
 accessibleProcs :: H.Statement Schema (M.HashMap Text [ProcDescription])
-accessibleProcs = H.Statement (toS sql) (HE.param HE.text) decodeProcs True
+accessibleProcs = H.Statement (toS sql) (param HE.text) decodeProcs True
   where
     sql = procsSqlQuery <> " AND has_function_privilege(p.oid, 'execute')"
 
@@ -186,7 +208,7 @@ procsSqlQuery = [q|
 
 schemaDescription :: H.Statement Schema (Maybe Text)
 schemaDescription =
-    H.Statement sql (HE.param HE.text) (join <$> HD.rowMaybe (HD.nullableColumn HD.text)) True
+    H.Statement sql (param HE.text) (join <$> HD.rowMaybe (nullableColumn HD.text)) True
   where
     sql = [q|
       select
@@ -199,7 +221,7 @@ schemaDescription =
 
 accessibleTables :: H.Statement Schema [Table]
 accessibleTables =
-  H.Statement sql (HE.param HE.text) decodeTables True
+  H.Statement sql (param HE.text) decodeTables True
  where
   sql = [q|
     select
@@ -230,7 +252,7 @@ addForeignKeys :: [Relation] -> [Column] -> [Column]
 addForeignKeys rels = map addFk
   where
     addFk col = col { colFK = fk col }
-    fk col = join $ relToFk col <$> find (lookupFn col) rels
+    fk col = find (lookupFn col) rels >>= relToFk col
     lookupFn :: Column -> Relation -> Bool
     lookupFn c Relation{relColumns=cs, relType=rty} = c `elem` cs && rty==Child
     relToFk col Relation{relColumns=cols, relFColumns=colsF} = do
@@ -285,19 +307,28 @@ addViewChildRelations allSyns = concatMap (\rel ->
           -- Relation is dependent on the order of relColumns and relFColumns to get the join conditions right in the generated query.
           -- So we need to change the order of the synonyms to match the relColumns
           -- This could be avoided if the Relation type is improved with a structure that maintains the association of relColumns and relFColumns
-          syns `sortAccordingTo` columns = sortOn (\(k, _) -> L.lookup k $ zip columns [0::Int ..]) syns in
+          syns `sortAccordingTo` columns = sortOn (\(k, _) -> L.lookup k $ zip columns [0::Int ..]) syns
 
-      -- View Table Child Relations
-      [Relation (getView syns) (snd <$> syns `sortAccordingTo` relColumns) relFTable relFColumns Child Nothing Nothing Nothing
-        | syns <- colsSyns, syns `allSynsOf` relColumns] ++
+          viewTableChild =
+            [ Relation (getView syns) (snd <$> syns `sortAccordingTo` relColumns)
+                       relFTable relFColumns
+                       Child Nothing Nothing Nothing
+            | syns <- colsSyns, syns `allSynsOf` relColumns ]
 
-      -- Table View Child Relations
-      [Relation relTable relColumns (getView fSyns) (snd <$> fSyns `sortAccordingTo` relFColumns) Child Nothing Nothing Nothing
-        | fSyns <- fColsSyns, fSyns `allSynsOf` relFColumns] ++
+          tableViewChild =
+            [ Relation relTable relColumns
+                       (getView fSyns) (snd <$> fSyns `sortAccordingTo` relFColumns)
+                       Child Nothing Nothing Nothing
+            | fSyns <- fColsSyns, fSyns `allSynsOf` relFColumns ]
 
-      -- View View Child Relations
-      [Relation (getView syns) (snd <$> syns `sortAccordingTo` relColumns) (getView fSyns) (snd <$> fSyns `sortAccordingTo` relFColumns) Child Nothing Nothing Nothing
-        | syns <- colsSyns, fSyns <- fColsSyns, syns `allSynsOf` relColumns, fSyns `allSynsOf` relFColumns]
+          viewViewChild =
+            [ Relation (getView syns) (snd <$> syns `sortAccordingTo` relColumns)
+                       (getView fSyns) (snd <$> fSyns `sortAccordingTo` relFColumns)
+                       Child Nothing Nothing Nothing
+            | syns <- colsSyns, syns `allSynsOf` relColumns
+            , fSyns <- fColsSyns, fSyns `allSynsOf` relFColumns ]
+
+      in viewTableChild ++ tableViewChild ++ viewViewChild
 
     _ -> [])
 
@@ -332,7 +363,7 @@ addViewPrimaryKeys syns = concatMap (\pk ->
 
 allTables :: H.Statement () [Table]
 allTables =
-  H.Statement sql HE.unit decodeTables True
+  H.Statement sql HE.noParams decodeTables True
  where
   sql = [q|
     SELECT
@@ -355,7 +386,7 @@ allTables =
 
 allColumns :: [Table] -> H.Statement Schema [Column]
 allColumns tabs =
-  H.Statement sql (HE.param HE.text) (decodeColumns tabs) True
+  H.Statement sql (param HE.text) (decodeColumns tabs) True
  where
   sql = [q|
     SELECT DISTINCT
@@ -542,7 +573,7 @@ columnFromRow tabs (s, t, n, desc, pos, nul, typ, u, l, p, d, e) = buildColumn <
 
 allChildRelations :: [Table] -> [Column] -> H.Statement () [Relation]
 allChildRelations tabs cols =
-  H.Statement sql HE.unit (decodeRelations tabs cols) True
+  H.Statement sql HE.noParams (decodeRelations tabs cols) True
  where
   sql = [q|
     SELECT ns1.nspname AS table_schema,
@@ -583,7 +614,7 @@ relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
 
 allPrimaryKeys :: [Table] -> H.Statement () [PrimaryKey]
 allPrimaryKeys tabs =
-  H.Statement sql HE.unit (decodePks tabs) True
+  H.Statement sql HE.noParams (decodePks tabs) True
  where
   sql = [q|
     /*
@@ -693,12 +724,15 @@ pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
 
 allSynonyms :: [Column] -> PgVersion -> H.Statement Schema [Synonym]
 allSynonyms cols pgVer =
-  H.Statement sql (HE.param HE.text) (decodeSynonyms cols) True
+  H.Statement sql (param HE.text) (decodeSynonyms cols) True
   -- query explanation at https://gist.github.com/steve-chavez/7ee0e6590cddafb532e5f00c46275569
   where
     subselectRegex :: Text
-    subselectRegex | pgVer < pgVersion100 = ":subselect {.*?:constraintDeps <>} :location"
-                   | otherwise = ":subselect {.*?:stmt_len 0} :location"
+    -- "result" appears when the subselect is used inside "case when", see `authors_have_book_in_decade` fixture
+    -- "resno"  appears in every other case
+    -- when copying the query into pg make sure you omit one backslash from \\d+, it should be like `\d+` for the regex
+    subselectRegex | pgVer < pgVersion100 = ":subselect {.*?:constraintDeps <>} :location \\d+} :res(no|ult)"
+                   | otherwise = ":subselect {.*?:stmt_len 0} :location \\d+} :res(no|ult)"
     sql = [qc|
       with
       views as (
@@ -709,7 +743,7 @@ allSynonyms cols pgVer =
         from pg_class c
         join pg_namespace n on n.oid = c.relnamespace
         join pg_rewrite r on r.ev_class = c.oid
-        where (c.relkind = 'v'::char) and n.nspname = $1
+        where (c.relkind in ('v', 'm')) and n.nspname = $1
       ),
       removed_subselects as(
         select
@@ -765,7 +799,7 @@ synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
     findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols
 
 getPgVersion :: H.Session PgVersion
-getPgVersion = H.statement () $ H.Statement sql HE.unit versionRow False
+getPgVersion = H.statement () $ H.Statement sql HE.noParams versionRow False
   where
     sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
-    versionRow = HD.singleRow $ PgVersion <$> HD.column HD.int4 <*> HD.column HD.text
+    versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text

src/PostgREST/Error.hs

@@ -1,97 +1,70 @@
+{-|
+Module      : PostgREST.Error
+Description : PostgREST error HTTP responses
+-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE FlexibleInstances    #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 module PostgREST.Error (
-  apiRequestError
-, pgError
-, simpleError
+  errorResponseFor
+, ApiRequestError(..)
+, PgError(..)
+, SimpleError(..)
+, errorPayload
+, checkIsFatal
 , singularityError
-, binaryFieldError
-, connectionLostError
-, encodeError
-, gucHeadersError
 ) where
 
-import           Protolude
-import           Data.Aeson                ((.=))
 import qualified Data.Aeson                as JSON
-import           Data.Text                 (unwords)
 import qualified Hasql.Pool                as P
 import qualified Hasql.Session             as H
-import           Network.HTTP.Types.Header
 import qualified Network.HTTP.Types.Status as HT
-import           Network.Wai               (Response, responseLBS)
-import           PostgREST.Types
-import           Text.Read                 (readMaybe)
 
-apiRequestError :: ApiRequestError -> Response
-apiRequestError err =
-  errorResponse status
-    [toHeader CTApplicationJSON] err
-  where
-    status =
-      case err of
-        ActionInappropriate -> HT.status405
-        UnsupportedVerb -> HT.status405
-        InvalidBody _ -> HT.status400
-        ParseRequestError _ _ -> HT.status400
-        NoRelationBetween _ _ -> HT.status400
-        InvalidRange -> HT.status416
-        UnknownRelation -> HT.status404
-        InvalidFilters -> HT.status405
+import Data.Aeson  ((.=))
+import Data.Text   (unwords)
+import Network.Wai (Response, responseLBS)
+import Text.Read   (readMaybe)
 
-simpleError :: HT.Status -> [Header] -> Text -> Response
-simpleError status hdrs message =
-  errorResponse status (toHeader CTApplicationJSON : hdrs) $
-    JSON.object ["message" .= message]
+import Network.HTTP.Types.Header
 
-errorResponse :: JSON.ToJSON a => HT.Status -> [Header] -> a -> Response
-errorResponse status hdrs e =
-  responseLBS status hdrs $ encodeError e
-
-pgError :: Bool -> P.UsageError -> Response
-pgError authed e =
-  let status = httpStatus authed e
-      jsonType = toHeader CTApplicationJSON
-      wwwAuth = ("WWW-Authenticate", "Bearer")
-      hdrs = if status == HT.status401
-                then [jsonType, wwwAuth]
-                else [jsonType] in
-  responseLBS status hdrs (encodeError e)
-
-singularityError :: Integer -> Response
-singularityError numRows =
-  responseLBS HT.status406
-    [toHeader CTSingularJSON]
-    $ toS . formatGeneralError
-      "JSON object requested, multiple (or no) rows returned"
-      $ unwords
-        [ "Results contain", show numRows, "rows,"
-        , toS (toMime CTSingularJSON), "requires 1 row"
-        ]
-  where
-    formatGeneralError :: Text -> Text -> Text
-    formatGeneralError message details = toS . JSON.encode $
-      JSON.object ["message" .= message, "details" .= details]
+import PostgREST.Types
+import Protolude
 
 
-binaryFieldError :: Response
-binaryFieldError =
-  simpleError HT.status406 [] (toS (toMime CTOctetStream) <>
-  " requested but a single column was not selected")
+class (JSON.ToJSON a) => PgrstError a where
+  status   :: a -> HT.Status
+  headers  :: a -> [Header]
 
-gucHeadersError :: Response
-gucHeadersError =
- simpleError HT.status500 []
- "response.headers guc must be a JSON array composed of objects with a single key and a string value"
+  errorPayload :: a -> LByteString
+  errorPayload = JSON.encode
 
-connectionLostError :: Response
-connectionLostError =
-  simpleError HT.status503 [] "Database connection lost, retrying the connection."
+  errorResponseFor :: a -> Response
+  errorResponseFor err = responseLBS (status err) (headers err) $ errorPayload err
 
-encodeError :: JSON.ToJSON a => a -> LByteString
-encodeError = JSON.encode
+
+
+data ApiRequestError
+  = ActionInappropriate
+  | InvalidRange
+  | InvalidBody ByteString
+  | ParseRequestError Text Text
+  | NoRelationBetween Text Text
+  | InvalidFilters
+  | UnknownRelation                -- Unreachable?
+  | UnsupportedVerb                -- Unreachable?
+  deriving (Show, Eq)
+
+instance PgrstError ApiRequestError where
+  status InvalidRange            = HT.status416
+  status InvalidFilters          = HT.status405
+  status (InvalidBody _)         = HT.status400
+  status UnsupportedVerb         = HT.status405
+  status UnknownRelation         = HT.status404
+  status ActionInappropriate     = HT.status405
+  status (ParseRequestError _ _) = HT.status400
+  status (NoRelationBetween _ _) = HT.status400
+
+  headers _ = [toHeader CTApplicationJSON]
 
 instance JSON.ToJSON ApiRequestError where
   toJSON (ParseRequestError message details) = JSON.object [
@@ -111,9 +84,24 @@ instance JSON.ToJSON ApiRequestError where
   toJSON InvalidFilters = JSON.object [
     "message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text)]
 
+
+data PgError = PgError Authenticated P.UsageError
+type Authenticated = Bool
+
+instance PgrstError PgError where
+  status (PgError authed usageError) = pgErrorStatus authed usageError
+
+  headers err =
+    if status err == HT.status401
+       then [toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
+       else [toHeader CTApplicationJSON]
+
+instance JSON.ToJSON PgError where
+  toJSON (PgError _ usageError) = JSON.toJSON usageError
+
 instance JSON.ToJSON P.UsageError where
   toJSON (P.ConnectionError e) = JSON.object [
-    "code" .= ("" :: Text),
+    "code"    .= ("" :: Text),
     "message" .= ("Database connection error" :: Text),
     "details" .= (toS $ fromMaybe "" e :: Text)]
   toJSON (P.SessionError e) = JSON.toJSON e -- H.Error
@@ -123,69 +111,146 @@ instance JSON.ToJSON H.QueryError where
 
 instance JSON.ToJSON H.CommandError where
   toJSON (H.ResultError (H.ServerError c m d h)) = case toS c of
-    'P':'T':_ ->
-      JSON.object [
-        "details" .= (fmap toS d::Maybe Text),
-        "hint" .= (fmap toS h::Maybe Text)]
-    _ ->
-      JSON.object [
-        "code" .= (toS c::Text),
-        "message" .= (toS m::Text),
-        "details" .= (fmap toS d::Maybe Text),
-        "hint" .= (fmap toS h::Maybe Text)]
+    'P':'T':_ -> JSON.object [
+        "details" .= (fmap toS d :: Maybe Text),
+        "hint"    .= (fmap toS h :: Maybe Text)]
+
+    _         -> JSON.object [
+        "code"    .= (toS c      :: Text),
+        "message" .= (toS m      :: Text),
+        "details" .= (fmap toS d :: Maybe Text),
+        "hint"    .= (fmap toS h :: Maybe Text)]
+
   toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [
-    "message" .= (m::Text)]
+    "message" .= (m :: Text)]
   toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [
-    "message" .= ("Row error: end of input"::Text),
-    "details" .=
-      ("Attempt to parse more columns than there are in the result"::Text),
-    "details" .= (("Row number " <> show i)::Text)]
+    "message" .= ("Row error: end of input" :: Text),
+    "details" .= ("Attempt to parse more columns than there are in the result" :: Text),
+    "hint"    .= (("Row number " <> show i) :: Text)]
   toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [
-    "message" .= ("Row error: unexpected null"::Text),
-    "details" .= ("Attempt to parse a NULL as some value."::Text),
-    "details" .= (("Row number " <> show i)::Text)]
+    "message" .= ("Row error: unexpected null" :: Text),
+    "details" .= ("Attempt to parse a NULL as some value." :: Text),
+    "hint"    .= (("Row number " <> show i) :: Text)]
   toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [
-    "message" .= ("Row error: Wrong value parser used"::Text),
+    "message" .= ("Row error: Wrong value parser used" :: Text),
     "details" .= d,
-    "details" .= (("Row number " <> show i)::Text)]
+    "hint"    .= (("Row number " <> show i) :: Text)]
   toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [
-    "message" .= ("Unexpected amount of rows"::Text),
+    "message" .= ("Unexpected amount of rows" :: Text),
     "details" .= i]
   toJSON (H.ClientError d) = JSON.object [
-    "message" .= ("Database client error"::Text),
-    "details" .= (fmap toS d::Maybe Text)]
+    "message" .= ("Database client error" :: Text),
+    "details" .= (fmap toS d :: Maybe Text)]
 
-httpStatus :: Bool -> P.UsageError -> HT.Status
-httpStatus _ (P.ConnectionError _) = HT.status503
-httpStatus authed (P.SessionError (H.QueryError _ _ (H.ResultError (H.ServerError c m _ _)))) =
-  case toS c of
-    '0':'8':_ -> HT.status503 -- pg connection err
-    '0':'9':_ -> HT.status500 -- triggered action exception
-    '0':'L':_ -> HT.status403 -- invalid grantor
-    '0':'P':_ -> HT.status403 -- invalid role specification
-    "23503"   -> HT.status409 -- foreign_key_violation
-    "23505"   -> HT.status409 -- unique_violation
-    '2':'5':_ -> HT.status500 -- invalid tx state
-    '2':'8':_ -> HT.status403 -- invalid auth specification
-    '2':'D':_ -> HT.status500 -- invalid tx termination
-    '3':'8':_ -> HT.status500 -- external routine exception
-    '3':'9':_ -> HT.status500 -- external routine invocation
-    '3':'B':_ -> HT.status500 -- savepoint exception
-    '4':'0':_ -> HT.status500 -- tx rollback
-    '5':'3':_ -> HT.status503 -- insufficient resources
-    '5':'4':_ -> HT.status413 -- too complex
-    '5':'5':_ -> HT.status500 -- obj not on prereq state
-    '5':'7':_ -> HT.status500 -- operator intervention
-    '5':'8':_ -> HT.status500 -- system error
-    'F':'0':_ -> HT.status500 -- conf file error
-    'H':'V':_ -> HT.status500 -- foreign data wrapper error
-    "P0001"   -> HT.status400 -- default code for "raise"
-    'P':'0':_ -> HT.status500 -- PL/pgSQL Error
-    'X':'X':_ -> HT.status500 -- internal Error
-    "42883"   -> HT.status404 -- undefined function
-    "42P01"   -> HT.status404 -- undefined table
-    "42501"   -> if authed then HT.status403 else HT.status401 -- insufficient privilege
-    'P':'T':n -> fromMaybe HT.status500 (HT.mkStatus <$> readMaybe n <*> pure m)
-    _         -> HT.status400
-httpStatus _ (P.SessionError (H.QueryError _ _ (H.ResultError _))) = HT.status500
-httpStatus _ (P.SessionError (H.QueryError _ _ (H.ClientError _))) = HT.status503
+pgErrorStatus :: Bool -> P.UsageError -> HT.Status
+pgErrorStatus _      (P.ConnectionError _)                                      = HT.status503
+pgErrorStatus _      (P.SessionError (H.QueryError _ _ (H.ClientError _)))      = HT.status503
+pgErrorStatus authed (P.SessionError (H.QueryError _ _ (H.ResultError rError))) =
+  case rError of
+    (H.ServerError c m _ _) ->
+      case toS c of
+        '0':'8':_ -> HT.status503 -- pg connection err
+        '0':'9':_ -> HT.status500 -- triggered action exception
+        '0':'L':_ -> HT.status403 -- invalid grantor
+        '0':'P':_ -> HT.status403 -- invalid role specification
+        "23503"   -> HT.status409 -- foreign_key_violation
+        "23505"   -> HT.status409 -- unique_violation
+        '2':'5':_ -> HT.status500 -- invalid tx state
+        '2':'8':_ -> HT.status403 -- invalid auth specification
+        '2':'D':_ -> HT.status500 -- invalid tx termination
+        '3':'8':_ -> HT.status500 -- external routine exception
+        '3':'9':_ -> HT.status500 -- external routine invocation
+        '3':'B':_ -> HT.status500 -- savepoint exception
+        '4':'0':_ -> HT.status500 -- tx rollback
+        '5':'3':_ -> HT.status503 -- insufficient resources
+        '5':'4':_ -> HT.status413 -- too complex
+        '5':'5':_ -> HT.status500 -- obj not on prereq state
+        '5':'7':_ -> HT.status500 -- operator intervention
+        '5':'8':_ -> HT.status500 -- system error
+        'F':'0':_ -> HT.status500 -- conf file error
+        'H':'V':_ -> HT.status500 -- foreign data wrapper error
+        "P0001"   -> HT.status400 -- default code for "raise"
+        'P':'0':_ -> HT.status500 -- PL/pgSQL Error
+        'X':'X':_ -> HT.status500 -- internal Error
+        "42883"   -> HT.status404 -- undefined function
+        "42P01"   -> HT.status404 -- undefined table
+        "42501"   -> if authed then HT.status403 else HT.status401 -- insufficient privilege
+        'P':'T':n -> fromMaybe HT.status500 (HT.mkStatus <$> readMaybe n <*> pure m)
+        _         -> HT.status400
+
+    _                       -> HT.status500
+
+checkIsFatal :: PgError -> Maybe Text
+checkIsFatal (PgError _ (P.ConnectionError e))
+  | isAuthFailureMessage = Just $ toS failureMessage
+  | otherwise = Nothing
+  where isAuthFailureMessage = "FATAL:  password authentication failed" `isPrefixOf` toS failureMessage
+        failureMessage = fromMaybe "" e
+checkIsFatal _ = Nothing
+
+
+data SimpleError
+  = GucHeadersError
+  | BinaryFieldError ContentType
+  | ConnectionLostError
+  | PutSingletonError
+  | PutMatchingPkError
+  | PutRangeNotAllowedError
+  | PutPayloadIncompleteError
+  | JwtTokenMissing
+  | JwtTokenInvalid Text
+  | SingularityError Integer
+  | ContentTypeError [ByteString]
+  deriving (Show, Eq)
+
+instance PgrstError SimpleError where
+  status GucHeadersError           = HT.status500
+  status (BinaryFieldError _)      = HT.status406
+  status ConnectionLostError       = HT.status503
+  status PutSingletonError         = HT.status400
+  status PutMatchingPkError        = HT.status400
+  status PutRangeNotAllowedError   = HT.status400
+  status PutPayloadIncompleteError = HT.status400
+  status JwtTokenMissing           = HT.status500
+  status (JwtTokenInvalid _)       = HT.unauthorized401
+  status (SingularityError _)      = HT.status406
+  status (ContentTypeError _)      = HT.status415
+
+  headers (SingularityError _)     = [toHeader CTSingularJSON]
+  headers (JwtTokenInvalid m)      = [toHeader CTApplicationJSON, invalidTokenHeader m]
+  headers _                        = [toHeader CTApplicationJSON]
+
+instance JSON.ToJSON SimpleError where
+  toJSON GucHeadersError           = JSON.object [
+    "message" .= ("response.headers guc must be a JSON array composed of objects with a single key and a string value" :: Text)]
+  toJSON (BinaryFieldError ct)          = JSON.object [
+    "message" .= ((toS (toMime ct) <> " requested but a single column was not selected") :: Text)]
+  toJSON ConnectionLostError       = JSON.object [
+    "message" .= ("Database connection lost, retrying the connection." :: Text)]
+
+  toJSON PutSingletonError         = JSON.object [
+    "message" .= ("PUT payload must contain a single row" :: Text)]
+  toJSON PutRangeNotAllowedError   = JSON.object [
+    "message" .= ("Range header and limit/offset querystring parameters are not allowed for PUT" :: Text)]
+  toJSON PutPayloadIncompleteError = JSON.object [
+    "message" .= ("You must specify all columns in the payload when using PUT" :: Text)]
+  toJSON PutMatchingPkError        = JSON.object [
+    "message" .= ("Payload values do not match URL in primary key column(s)" :: Text)]
+
+  toJSON (ContentTypeError cts)    = JSON.object [
+    "message" .= ("None of these Content-Types are available: " <> (toS . intercalate ", " . map toS) cts :: Text)]
+  toJSON (SingularityError n)      = JSON.object [
+    "message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
+    "details" .= unwords ["Results contain", show n, "rows,", toS (toMime CTSingularJSON), "requires 1 row"]]
+
+  toJSON JwtTokenMissing           = JSON.object [
+    "message" .= ("Server lacks JWT secret" :: Text)]
+  toJSON (JwtTokenInvalid message) = JSON.object [
+    "message" .= (message :: Text)]
+
+invalidTokenHeader :: Text -> Header
+invalidTokenHeader m =
+  ("WWW-Authenticate", "Bearer error=\"invalid_token\", " <> "error_description=" <> show m)
+
+singularityError :: (Integral a) => a -> SimpleError
+singularityError = SingularityError . toInteger

src/PostgREST/Middleware.hs

@@ -1,37 +1,42 @@
+{-|
+Module      : PostgREST.Middleware
+Description : Sets the PostgreSQL GUCs, role, search_path and pre-request function. Validates JWT.
+-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleContexts #-}
 
 module PostgREST.Middleware where
 
-import           Crypto.JWT
-import qualified Data.Aeson                    as JSON
-import qualified Data.HashMap.Strict           as M
-import qualified Hasql.Transaction             as H
+import qualified Data.Aeson          as JSON
+import qualified Data.HashMap.Strict as M
+import qualified Hasql.Transaction   as H
 
-import           Network.HTTP.Types.Status     (unauthorized401, status500)
-import           Network.Wai                   (Application, Response)
-import           Network.Wai.Middleware.Cors   (cors)
-import           Network.Wai.Middleware.Gzip   (def, gzip)
-import           Network.Wai.Middleware.Static (only, staticPolicy)
+import Network.Wai                   (Application, Response)
+import Network.Wai.Middleware.Cors   (cors)
+import Network.Wai.Middleware.Gzip   (def, gzip)
+import Network.Wai.Middleware.Static (only, staticPolicy)
 
-import           PostgREST.ApiRequest          (ApiRequest(..))
-import           PostgREST.Auth                (JWTAttempt(..))
-import           PostgREST.Config              (AppConfig (..), corsPolicy)
-import           PostgREST.Error               (simpleError)
-import           PostgREST.QueryBuilder        (unquoted, pgFmtSetLocal, pgFmtSetLocalSearchPath)
+import Crypto.JWT
 
-import           Protolude
+import PostgREST.ApiRequest   (ApiRequest (..))
+import PostgREST.Auth         (JWTAttempt (..))
+import PostgREST.Config       (AppConfig (..), corsPolicy)
+import PostgREST.Error        (SimpleError (JwtTokenInvalid, JwtTokenMissing),
+                               errorResponseFor)
+import PostgREST.QueryBuilder (pgFmtSetLocal, pgFmtSetLocalSearchPath,
+                               unquoted)
+import Protolude
 
 runWithClaims :: AppConfig -> JWTAttempt ->
                  (ApiRequest -> H.Transaction Response) ->
                  ApiRequest -> H.Transaction Response
 runWithClaims conf eClaims app req =
   case eClaims of
-    JWTInvalid JWTExpired -> return $ unauthed "JWT expired"
-    JWTInvalid e -> return $ unauthed $ show e
-    JWTMissingSecret -> return $ simpleError status500 [] "Server lacks JWT secret"
-    JWTClaims claims -> do
+    JWTMissingSecret      -> return . errorResponseFor $ JwtTokenMissing
+    JWTInvalid JWTExpired -> return . errorResponseFor . JwtTokenInvalid $ "JWT expired"
+    JWTInvalid e          -> return . errorResponseFor . JwtTokenInvalid . show $ e
+    JWTClaims claims      -> do
       H.sql $ toS . mconcat $ setSearchPathSql : setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql ++ appSettingsSql
       mapM_ H.sql customReqCheck
       app req
@@ -47,14 +52,6 @@ runWithClaims conf eClaims app req =
         claimsWithRole = M.union claims (M.singleton "role" anon)
         anon = JSON.String . toS $ configAnonRole conf
         customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf
-  where
-    unauthed message = simpleError
-      unauthorized401
-      [( "WWW-Authenticate"
-        , "Bearer error=\"invalid_token\", " <>
-          "error_description=" <> show message
-      )]
-      message
 
 defaultMiddle :: Application -> Application
 defaultMiddle =

src/PostgREST/OpenAPI.hs

@@ -1,40 +1,54 @@
+{-|
+Module      : PostgREST.OpenAPI
+Description : Generates the OpenAPI output
+-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module PostgREST.OpenAPI (
   encodeOpenAPI
-  , isMalformedProxyUri
-  , pickProxy
-  ) where
+, isMalformedProxyUri
+, pickProxy
+) where
 
-import           Control.Arrow               ((&&&))
-import           Control.Lens
-import           Data.Aeson                  (decode, encode)
-import           Data.HashMap.Strict.InsOrd  (InsOrdHashMap, fromList)
-import           Data.Maybe                  (fromJust)
-import qualified Data.Set                    as Set
-import           Data.String                 (IsString (..))
-import           Data.Text                   (unpack, pack, init, tail, toLower, intercalate, append, dropWhile, breakOn)
-import           Network.URI                 (parseURI, isAbsoluteURI,
-                                              URI (..), URIAuth (..))
+import qualified Data.Set as Set
 
-import           Protolude hiding              ((&), Proxy, get, intercalate, dropWhile)
+import Control.Arrow              ((&&&))
+import Data.Aeson                 (decode, encode)
+import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList)
+import Data.Maybe                 (fromJust)
+import Data.String                (IsString (..))
+import Data.Text                  (append, breakOn, dropWhile, init,
+                                   intercalate, pack, tail, toLower,
+                                   unpack)
+import Network.URI                (URI (..), URIAuth (..),
+                                   isAbsoluteURI, parseURI)
 
-import           Data.Swagger
+import Control.Lens
+import Data.Swagger
 
-import           PostgREST.ApiRequest        (ContentType(..))
-import           PostgREST.Config            (prettyVersion, docsVersion)
-import           PostgREST.Types             (Table(..), Column(..), PgArg(..), ForeignKey(..),
-                                              PrimaryKey(..), Proxy(..), ProcDescription(..), toMime)
+import PostgREST.ApiRequest (ContentType (..))
+import PostgREST.Config     (docsVersion, prettyVersion)
+import PostgREST.Types      (Column (..), ForeignKey (..), PgArg (..),
+                             PrimaryKey (..), ProcDescription (..),
+                             Proxy (..), Table (..), toMime)
+import Protolude            hiding (Proxy, dropWhile, get,
+                             intercalate, (&))
 
 makeMimeList :: [ContentType] -> MimeList
 makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs
 
 toSwaggerType :: Text -> SwaggerType t
-toSwaggerType "text"      = SwaggerString
-toSwaggerType "integer"   = SwaggerInteger
-toSwaggerType "boolean"   = SwaggerBoolean
-toSwaggerType "numeric"   = SwaggerNumber
-toSwaggerType _           = SwaggerString
+toSwaggerType "character varying" = SwaggerString
+toSwaggerType "character"         = SwaggerString
+toSwaggerType "text"              = SwaggerString
+toSwaggerType "boolean"           = SwaggerBoolean
+toSwaggerType "smallint"          = SwaggerInteger
+toSwaggerType "integer"           = SwaggerInteger
+toSwaggerType "bigint"            = SwaggerInteger
+toSwaggerType "numeric"           = SwaggerNumber
+toSwaggerType "real"              = SwaggerNumber
+toSwaggerType "double precision"  = SwaggerNumber
+toSwaggerType _                   = SwaggerString
 
 makeTableDef :: [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
 makeTableDef pks (t, cs, _) =
@@ -319,7 +333,7 @@ pickProxy proxy
    uri = toURI $ fromJust proxy
    scheme = init $ toLower $ pack $ uriScheme uri
    path URI {uriPath = ""} =  "/"
-   path URI {uriPath = p} = p
+   path URI {uriPath = p}  = p
    path' = pack $ path uri
    authority = fromJust $ uriAuthority uri
    host' = pack $ uriRegName authority
@@ -327,15 +341,15 @@ pickProxy proxy
    readPort = fromMaybe 80 . readMaybe
    port'' :: Integer
    port'' = case (port', scheme) of
-             ("", "http") -> 80
+             ("", "http")  -> 80
              ("", "https") -> 443
-             _ -> readPort $ unpack $ tail $ pack port'
+             _             -> readPort $ unpack $ tail $ pack port'
 
 isUriValid:: URI -> Bool
 isUriValid = fAnd [isSchemeValid, isQueryValid, isAuthorityValid]
 
 fAnd :: [a -> Bool] -> a -> Bool
-fAnd fs x = all ($x) fs
+fAnd fs x = all ($ x) fs
 
 isSchemeValid :: URI -> Bool
 isSchemeValid URI {uriScheme = s}
@@ -345,7 +359,7 @@ isSchemeValid URI {uriScheme = s}
 
 isQueryValid :: URI -> Bool
 isQueryValid URI {uriQuery = ""} = True
-isQueryValid _ = False
+isQueryValid _                   = False
 
 isAuthorityValid :: URI -> Bool
 isAuthorityValid URI {uriAuthority = a}
@@ -354,16 +368,16 @@ isAuthorityValid URI {uriAuthority = a}
 
 isUserInfoValid :: URIAuth -> Bool
 isUserInfoValid URIAuth {uriUserInfo = ""} = True
-isUserInfoValid _ = False
+isUserInfoValid _                          = False
 
 isHostValid :: URIAuth -> Bool
 isHostValid URIAuth {uriRegName = ""} = False
-isHostValid _ = True
+isHostValid _                         = True
 
 isPortValid :: URIAuth -> Bool
 isPortValid URIAuth {uriPort = ""} = True
 isPortValid URIAuth {uriPort = (':':p)} =
   case readMaybe p of
-    Just i -> i > (0 :: Integer) && i < 65536
+    Just i  -> i > (0 :: Integer) && i < 65536
     Nothing -> False
 isPortValid _ = False

src/PostgREST/Parsers.hs

@@ -1,19 +1,30 @@
+{-|
+Module      : PostgREST.Parsers
+Description : PostgREST parser combinators
+
+This module is in charge of parsing all the querystring values in an url, e.g. the select, id, order in `/projects?select=id,name&id=eq.1&order=id,name.desc`.
+-}
 module PostgREST.Parsers where
 
-import           Protolude                     hiding (try, intercalate, replace, option)
-import           Control.Monad                 ((>>))
-import           Data.Foldable                 (foldl1)
-import           Data.Functor                  (($>))
-import qualified Data.HashMap.Strict           as M
-import           Data.Text                     (intercalate, replace, strip)
-import           Data.List                     (init, last)
-import           Data.Tree
-import           Data.Either.Combinators       (mapLeft)
-import           PostgREST.RangeQuery          (NonnegRange)
-import           PostgREST.Types
-import           Text.ParserCombinators.Parsec hiding (many, (<|>))
-import           Text.Parsec.Error
-import           Text.Read                     (read)
+import qualified Data.HashMap.Strict as M
+import qualified Data.Set            as S
+
+import Control.Monad           ((>>))
+import Data.Either.Combinators (mapLeft)
+import Data.Foldable           (foldl1)
+import Data.Functor            (($>))
+import Data.List               (init, last)
+import Data.Text               (intercalate, replace, strip)
+import Text.Read               (read)
+
+import Data.Tree
+import Text.Parsec.Error
+import Text.ParserCombinators.Parsec hiding (many, (<|>))
+
+import PostgREST.Error      (ApiRequestError (ParseRequestError))
+import PostgREST.RangeQuery (NonnegRange)
+import PostgREST.Types
+import Protolude            hiding (intercalate, option, replace, try)
 
 pRequestSelect :: Text -> Either ApiRequestError [Tree SelectItem]
 pRequestSelect selStr =
@@ -45,9 +56,18 @@ pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
   where
     path = parse pLogicPath ("failed to parser logic path (" ++ toS k ++ ")") $ toS k
     embedPath = fst <$> path
-    op = snd <$> path
-    -- Concat op and v to make pLogicTree argument regular, in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
-    logicTree = join $ parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") . toS <$> ((<>) <$> op <*> pure v)
+    logicTree = do
+      op <- snd <$> path
+      -- Concat op and v to make pLogicTree argument regular,
+      -- in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
+      parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") $ toS (op <> v)
+
+pRequestColumns :: Maybe Text -> Either ApiRequestError (Maybe (S.Set FieldName))
+pRequestColumns colStr =
+  case colStr of
+    Just str ->
+      mapError $ Just . S.fromList <$> parse pColumns ("failed to parse columns parameter (" <> toS str <> ")") (toS str)
+    _ -> Right Nothing
 
 ws :: Parser Text
 ws = toS <$> many (oneOf " \t")
@@ -110,7 +130,10 @@ pRelationSelect :: Parser SelectItem
 pRelationSelect = lexeme $ try ( do
     alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
     fld <- pField
-    relationDetail <- optionMaybe ( try( char '.' *> pFieldName ) )
+    relationDetail <- optionMaybe (
+        try ( char '+' *> pFieldName ) <|>
+        try ( char '.' *> pFieldName ) -- TODO deprecated, remove in next major version
+      )
 
     return (fld, Nothing, alias, relationDetail)
   )
@@ -211,6 +234,9 @@ pLogicPath = do
       notOp = "not." <> op
   return (filter (/= "not") (init path), if "not" `elem` path then notOp else op)
 
+pColumns :: Parser [FieldName]
+pColumns = pFieldName `sepBy1` lexeme (char ',')
+
 mapError :: Either ParseError a -> Either ApiRequestError a
 mapError = mapLeft translateError
   where

src/PostgREST/QueryBuilder.hs

@@ -1,6 +1,6 @@
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE LambdaCase            #-}
 {-# OPTIONS_GHC -fno-warn-orphans  #-}
 {-|
@@ -27,29 +27,41 @@ module PostgREST.QueryBuilder (
   , pgFmtSetLocalSearchPath
   ) where
 
-import qualified Hasql.Statement         as H
-import qualified Hasql.Encoders          as HE
-import qualified Hasql.Decoders          as HD
+import qualified Data.Aeson            as JSON
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.HashMap.Strict   as HM
+import qualified Data.Set              as S
+import qualified Data.Text             as T (map, null, takeWhile)
+import qualified Data.Text.Encoding    as T
+import qualified Hasql.Decoders        as HD
+import qualified Hasql.Encoders        as HE
+import qualified Hasql.Statement       as H
 
-import qualified Data.Aeson              as JSON
+import Data.Scientific               (FPFormat (..), formatScientific,
+                                      isInteger)
+import Data.Text                     (intercalate, isInfixOf, replace,
+                                      toLower, unwords)
+import Data.Tree                     (Tree (..))
+import Text.InterpolatedString.Perl6 (qc)
 
-import           PostgREST.RangeQuery    (rangeLimit, rangeOffset, allRange)
-import qualified Data.HashMap.Strict     as HM
-import           Data.Maybe
-import qualified Data.Set                as S
-import           Data.Text               (intercalate, unwords, replace, isInfixOf, toLower)
-import qualified Data.Text as T          (map, takeWhile, null)
-import qualified Data.Text.Encoding as T
-import           Data.Tree               (Tree(..))
-import           PostgREST.Types
-import           Text.InterpolatedString.Perl6 (qc)
-import qualified Data.ByteString.Char8   as BS
-import           Data.Scientific         ( FPFormat (..)
-                                         , formatScientific
-                                         , isInteger
-                                         )
-import           Protolude hiding        ( intercalate, cast, replace)
-import           PostgREST.ApiRequest    (PreferRepresentation (..))
+import Data.Maybe
+
+import PostgREST.ApiRequest (PreferRepresentation (..))
+import PostgREST.RangeQuery (allRange, rangeLimit, rangeOffset)
+import PostgREST.Types
+import Protolude            hiding (cast, intercalate, replace)
+
+column :: HD.Value a -> HD.Row a
+column = HD.column . HD.nonNullable
+
+nullableColumn :: HD.Value a -> HD.Row (Maybe a)
+nullableColumn = HD.column . HD.nullable
+
+element :: HD.Value a -> HD.Array a
+element = HD.element . HD.nonNullable
+
+param :: HE.Value a -> HE.Params a
+param = HE.param . HE.nonNullable
 
 {-| The generic query result format used by API responses. The location header
     is represented as a list of strings containing variable bindings like
@@ -58,10 +70,10 @@ import           PostgREST.ApiRequest    (PreferRepresentation (..))
 type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString)
 
 standardRow :: HD.Row ResultsWithCount
-standardRow = (,,,) <$> HD.nullableColumn HD.int8 <*> HD.column HD.int8
-                    <*> HD.column header <*> HD.column HD.bytea
+standardRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
+                    <*> column header <*> column HD.bytea
   where
-    header = HD.array $ HD.dimension replicateM $ HD.element HD.bytea
+    header = HD.array $ HD.dimension replicateM $ element HD.bytea
 
 noLocationF :: Text
 noLocationF = "array[]::text[]"
@@ -81,7 +93,7 @@ decodeStandardMay =
 createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->
                        H.Statement () ResultsWithCount
 createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =
-  unicodeStatement sql HE.unit decodeStandard False
+  unicodeStatement sql HE.noParams decodeStandard False
  where
   sql = [qc|
       WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols}
@@ -103,8 +115,8 @@ createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField
 createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
                         PreferRepresentation -> [Text] ->
                         H.Statement ByteString (Maybe ResultsWithCount)
-createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys =
-  unicodeStatement sql (HE.param HE.unknown) decodeStandardMay True
+createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys =
+  unicodeStatement sql (param HE.unknown) decodeStandardMay True
 
  where
   sql = case rep of
@@ -123,9 +135,14 @@ createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys
   cols = intercalate ", " [
       "'' AS total_result_set", -- when updateing it does not make sense
       "pg_catalog.count(_postgrest_t) AS page_total",
-      if wantHdrs
-         then "coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")"
-         else noLocationF <> " AS header",
+      if isInsert
+        then unwords [
+          "CASE",
+            "WHEN pg_catalog.count(_postgrest_t) = 1 THEN",
+              "coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",
+            "ELSE " <> noLocationF,
+          "END AS header"]
+        else noLocationF <> "AS header",
       if rep == Full
          then bodyF <> " AS body"
          else "''"
@@ -138,62 +155,75 @@ createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys
 
 type ProcResults = (Maybe Int64, Int64, ByteString, ByteString)
 callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bool ->
-            Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> Bool -> PgVersion ->
+            Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
             H.Statement ByteString (Maybe ProcResults)
-callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField isObject pgVer =
-  unicodeStatement sql (HE.param HE.unknown) decodeProc True
+callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField pgVer =
+  unicodeStatement sql (param HE.unknown) decodeProc True
   where
-    sql =
-     if returnsScalar then [qc|
-       WITH {argsRecord},
-       {sourceCTEName} AS (
-         SELECT {fromQi qi}({args})
-       )
-       SELECT
-         {countResultF} AS total_result_set,
-         1 AS page_total,
-         {scalarBodyF} AS body,
-         {responseHeaders} AS response_headers
-       FROM ({selectQuery}) _postgrest_t;|]
-     else [qc|
-       WITH {argsRecord},
-       {sourceCTEName} AS (
-         SELECT * FROM {fromQi qi}({args})
-       )
-       SELECT
-         {countResultF} AS total_result_set,
-         pg_catalog.count(_postgrest_t) AS page_total,
-         {bodyF} AS body,
-         {responseHeaders} AS response_headers
-       FROM ({selectQuery}) _postgrest_t;|]
+    sql =[qc|
+      WITH
+      {argsRecord},
+      {sourceCTEName} AS (
+        {sourceBody}
+      )
+      SELECT
+        {countResultF} AS total_result_set,
+        pg_catalog.count(_postgrest_t) AS page_total,
+        {bodyF} AS body,
+        {responseHeaders} AS response_headers
+      FROM ({selectQuery}) _postgrest_t;|]
+
+    (argsRecord, args)
+      | paramsAsSingleObject = ("_args_record AS (SELECT NULL)", "$1::json")
+      | null pgArgs = (ignoredBody, "")
+      | otherwise = (
+          unwords [
+            normalizedBody <> ",",
+            "_args_record AS (",
+              "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <>
+                intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " " <> pgaType a) <$> pgArgs) <> ")",
+            ")"]
+         , intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " := _args_record." <> pgFmtIdent (pgaName a)) <$> pgArgs))
+
+    sourceBody :: SqlFragment
+    sourceBody
+      | paramsAsSingleObject || null pgArgs =
+          if returnsScalar
+            then [qc| SELECT {fromQi qi}({args}) |]
+            else [qc| SELECT * FROM {fromQi qi}({args}) |]
+      | otherwise =
+          if returnsScalar
+            then [qc| SELECT {fromQi qi}({args}) FROM _args_record |]
+            else [qc| SELECT _.*
+                      FROM _args_record,
+                      LATERAL ( SELECT * FROM {fromQi qi}({args}) ) _ |]
+
+    bodyF
+     | returnsScalar = scalarBodyF
+     | isSingle = asJsonSingleF
+     | asCsv = asCsvF
+     | isJust binaryField = asBinaryF $ fromJust binaryField
+     | otherwise = asJsonF
+
+    scalarBodyF
+     | asBinary = asBinaryF _procName
+     | otherwise = unwords [
+        "CASE",
+          "WHEN pg_catalog.count(_postgrest_t) = 1",
+            "THEN (json_agg(_postgrest_t." <> pgFmtIdent _procName <> ")->0)::character varying",
+            "ELSE (json_agg(_postgrest_t." <> pgFmtIdent _procName <> "))::character varying",
+        "END"]
 
-    (argsRecord, args) | paramsAsSingleObject = ("_args_record AS (SELECT NULL)", "$1::json")
-                       | null pgArgs = (ignoredBody, "")
-                       | otherwise = (
-                           unwords [
-                           "_args_record AS (",
-                             "SELECT * FROM " <> (if isObject then "json_to_record" else "json_to_recordset") <> "($1)",
-                             "AS _(" <> intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " " <> pgaType a) <$> pgArgs) <> ")",
-                           ")"]
-                         , intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " := (SELECT " <> pgFmtIdent (pgaName a) <> " FROM _args_record)") <$> pgArgs))
     countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
     _procName = qiName qi
     responseHeaders =
       if pgVer >= pgVersion96
         then "coalesce(nullif(current_setting('response.headers', true), ''), '[]')" :: Text -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
         else "'[]'" :: Text
-    decodeProc = HD.rowMaybe procRow
-    procRow = (,,,) <$> HD.nullableColumn HD.int8 <*> HD.column HD.int8
-                    <*> HD.column HD.bytea <*> HD.column HD.bytea
-    scalarBodyF
-     | asBinary = asBinaryF _procName
-     | otherwise = "(row_to_json(_postgrest_t)->" <> pgFmtLit _procName <> ")::character varying"
 
-    bodyF
-     | isSingle = asJsonSingleF
-     | asCsv = asCsvF
-     | isJust binaryField = asBinaryF $ fromJust binaryField
-     | otherwise = asJsonF
+    decodeProc = HD.rowMaybe procRow
+    procRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
+                    <*> column HD.bytea <*> column HD.bytea
 
 pgFmtIdent :: SqlFragment -> SqlFragment
 pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\""
@@ -219,32 +249,21 @@ requestToCountQuery schema (DbRead (Node (Select{where_=logicForest}, (mainTbl,
    qi = removeSourceCTESchema schema mainTbl
 
 requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery
-requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest joinConditions_ ordts range, (nodeName, maybeRelation, _, _, depth)) forest)) =
+requestToQuery schema isParent (DbRead (Node (Select colSelects tbl tblAlias implJoins logicForest joinConditions_ ordts range, _) forest)) =
   unwords [
     "SELECT " <> intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
-    "FROM " <> intercalate ", " tables,
+    "FROM " <> intercalate ", " (tabl : implJs),
     unwords joins,
-    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConds))
-      `emptyOnFalse` (null logicForest && null joinConds),
+    ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_))
+      `emptyOnFalse` (null logicForest && null joinConditions_),
     ("ORDER BY " <> intercalate ", " (map (pgFmtOrderTerm qi) ordts)) `emptyOnFalse` null ordts,
     ("LIMIT " <> maybe "ALL" show (rangeLimit range) <> " OFFSET " <> show (rangeOffset range)) `emptyOnFalse` (isParent || range == allRange) ]
 
   where
-    mainTbl = maybe nodeName (tableName . relTable) maybeRelation
-    isSelfJoin = maybe False (\r -> relType r /= Root && relTable r == relFTable r) maybeRelation
-    (qi, tables, joinConds) =
-      let depthAlias name dpth = if dpth /= 0  then name <> "_" <> show dpth else name in -- Root node doesn't get aliased
-      if isSelfJoin
-        then (
-          QualifiedIdentifier "" (depthAlias mainTbl depth),
-          (\t -> fromQi (removeSourceCTESchema schema t) <> " AS " <> pgFmtIdent (depthAlias t depth)) <$> tbls,
-          (\(JoinCondition (qi1, _, c1) (qi2, _, c2)) ->
-            JoinCondition (qi1, Just $ depthAlias (qiName qi1) depth, c1)
-                          (qi2, Just $ depthAlias (qiName qi2) (depth - 1), c2)) <$> joinConditions_)
-        else (
-          removeSourceCTESchema schema mainTbl,
-          fromQi . removeSourceCTESchema schema <$> tbls,
-          joinConditions_)
+    implJs = fromQi . QualifiedIdentifier schema <$> implJoins
+    mainQi = removeSourceCTESchema schema tbl
+    tabl = fromQi mainQi <> maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias
+    qi = maybe mainQi (QualifiedIdentifier mempty) tblAlias
 
     (joins, selects) = foldr getQueryParts ([],[]) forest
 
@@ -274,48 +293,42 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest
     --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
     --posible relations are Child Parent Many
     getQueryParts _ _ = witness
-requestToQuery schema _ (DbMutate (Insert mainTbl pkCols p@(PayloadJSON _ pType pKeys) onConflct logicForest returnings)) =
+requestToQuery schema _ (DbMutate (Insert mainTbl iCols onConflct putConditions returnings)) =
   unwords [
-    ("WITH " <> ignoredBody) `emptyOnFalse` not payloadIsEmpty,
-    "INSERT INTO ", fromQi qi, if payloadIsEmpty then " " else "(" <> cols <> ")",
-    case (pType, payloadIsEmpty) of
-      (PJArray _, True) -> "SELECT null WHERE false"
-      (PJObject, True)  -> "DEFAULT VALUES"
-      _ -> unwords [
-        "SELECT " <> cols <> " FROM",
-        case pType of
-          PJObject  -> "json_populate_record"
-          PJArray _ -> "json_populate_recordset", "(null::", fromQi qi, ", $1) _",
-        -- Only used for PUT
-        ("WHERE " <> intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier "" "_") <$> logicForest)) `emptyOnFalse` null logicForest],
-    maybe "" (\x -> (
-      "ON CONFLICT(" <> intercalate ", " (pgFmtIdent <$> pkCols) <> ") " <> case x of
+    "WITH " <> normalizedBody,
+    "INSERT INTO ", fromQi qi, if S.null iCols then " " else "(" <> cols <> ")",
+    unwords [
+      "SELECT " <> cols <> " FROM",
+      "json_populate_recordset", "(null::", fromQi qi, ", " <> selectBody <> ") _",
+      -- Only used for PUT
+      ("WHERE " <> intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier "" "_") <$> putConditions)) `emptyOnFalse` null putConditions],
+    maybe "" (\(oncDo, oncCols) -> (
+      "ON CONFLICT(" <> intercalate ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
       IgnoreDuplicates ->
         "DO NOTHING"
       MergeDuplicates  ->
-        "DO UPDATE SET " <> intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList pKeys)
-    ) `emptyOnFalse` null pkCols) onConflct,
+        if S.null iCols
+           then "DO NOTHING"
+           else "DO UPDATE SET " <> intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList iCols)
+                                   ) `emptyOnFalse` null oncCols) onConflct,
     ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings]
   where
     qi = QualifiedIdentifier schema mainTbl
-    cols = intercalate ", " $ pgFmtIdent <$> S.toList pKeys
-    payloadIsEmpty = pjIsEmpty p
-requestToQuery schema _ (DbMutate (Update mainTbl p@(PayloadJSON _ pType keys) logicForest returnings)) =
-  if pjIsEmpty p
-    then "WITH " <> ignoredBody <> "SELECT ''"
+    cols = intercalate ", " $ pgFmtIdent <$> S.toList iCols
+requestToQuery schema _ (DbMutate (Update mainTbl uCols logicForest returnings)) =
+  if S.null uCols
+    then "WITH " <> ignoredBody <> "SELECT null WHERE false" -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
     else
       unwords [
+        "WITH " <> normalizedBody,
         "UPDATE " <> fromQi qi <> " SET " <> cols,
-        "FROM (SELECT * FROM ",
-        case pType of
-           PJObject  -> " json_populate_record"
-           PJArray _ -> " json_populate_recordset", "(null::", fromQi qi, ", $1)) _ ",
-        ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
-        ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
+        "FROM (SELECT * FROM json_populate_recordset", "(null::", fromQi qi, ", " <> selectBody <> ")) _ ",
+        ("WHERE " <> intercalate " AND " (pgFmtLogicTree qi <$> logicForest)) `emptyOnFalse` null logicForest,
+        ("RETURNING " <> intercalate ", " (pgFmtColumn qi <$> returnings)) `emptyOnFalse` null returnings
         ]
   where
     qi = QualifiedIdentifier schema mainTbl
-    cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList keys)
+    cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
 requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) =
   unwords [
     "WITH " <> ignoredBody,
@@ -333,6 +346,25 @@ requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) =
 ignoredBody :: SqlFragment
 ignoredBody = "ignored_body AS (SELECT $1::text) "
 
+-- |
+-- These CTEs convert a json object into a json array, this way we can use json_populate_recordset for all json payloads
+-- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays
+-- We do this in SQL to avoid processing the JSON in application code
+normalizedBody :: SqlFragment
+normalizedBody =
+  unwords [
+    "pgrst_payload AS (SELECT $1::json AS json_data),",
+    "pgrst_body AS (",
+      "SELECT",
+        "CASE WHEN json_typeof(json_data) = 'array'",
+          "THEN json_data",
+          "ELSE json_build_array(json_data)",
+        "END AS val",
+      "FROM pgrst_payload)"]
+
+selectBody :: SqlFragment
+selectBody = "(SELECT val FROM pgrst_body)"
+
 removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
 removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl
 
@@ -389,7 +421,7 @@ emptyOnFalse val cond = if cond then "" else val
 
 pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
 pgFmtColumn table "*" = fromQi table <> ".*"
-pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
+pgFmtColumn table c   = fromQi table <> "." <> pgFmtIdent c
 
 pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment
 pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
@@ -407,10 +439,10 @@ pgFmtOrderTerm qi ot = unwords [
 pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment
 pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
    Op op val  -> pgFmtFieldOp op <> " " <> case op of
-     "like"   -> unknownLiteral (T.map star val)
-     "ilike"  -> unknownLiteral (T.map star val)
-     "is"     -> whiteList val
-     _        -> unknownLiteral val
+     "like"  -> unknownLiteral (T.map star val)
+     "ilike" -> unknownLiteral (T.map star val)
+     "is"    -> whiteList val
+     _       -> unknownLiteral val
 
    In vals -> pgFmtField table fld <> " " <>
     let emptyValForIn = "= any('{}') " in -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')"
@@ -437,11 +469,9 @@ pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper
      (find ((==) . toLower $ v) ["null","true","false"])
 
 pgFmtJoinCondition :: JoinCondition -> SqlFragment
-pgFmtJoinCondition (JoinCondition (qi, al1, col1) (QualifiedIdentifier schema fTable, al2, col2)) =
-  pgFmtColumn (fromMaybe qi $ aliasToQi al1) col1 <> " = " <>
-  pgFmtColumn (fromMaybe (removeSourceCTESchema schema fTable) $ aliasToQi al2) col2
-  where
-    aliasToQi al = QualifiedIdentifier "" <$> al
+pgFmtJoinCondition (JoinCondition (qi, col1) (QualifiedIdentifier schema fTable, col2)) =
+  pgFmtColumn qi col1 <> " = " <>
+  pgFmtColumn (removeSourceCTESchema schema fTable) col2
 
 pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment
 pgFmtLogicTree qi (Expr hasNot op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")"

src/PostgREST/RangeQuery.hs

@@ -1,3 +1,7 @@
+{-|
+Module      : PostgREST.RangeQuery
+Description : Logic regarding the `Range` header and `limit`, `offset` querystring arguments.
+-}
 module PostgREST.RangeQuery (
   rangeParse
 , rangeRequested
@@ -9,19 +13,17 @@ module PostgREST.RangeQuery (
 , NonnegRange
 ) where
 
+import qualified Data.ByteString.Char8 as BS
 
-import           Control.Applicative
-import           Network.HTTP.Types.Header
+import Data.List       (lookup)
+import Text.Regex.TDFA ((=~))
 
-import qualified Data.ByteString.Char8     as BS
-import           Data.Ranged.Boundaries
-import           Data.Ranged.Ranges
+import Control.Applicative
+import Data.Ranged.Boundaries
+import Data.Ranged.Ranges
+import Network.HTTP.Types.Header
 
-import           Text.Regex.TDFA           ((=~))
-
-import Data.List (lookup)
-
-import           Protolude
+import Protolude
 
 type NonnegRange = Range Integer
 
@@ -56,7 +58,7 @@ rangeOffset :: NonnegRange -> Integer
 rangeOffset range =
   case rangeLower range of
     BoundaryBelow lower -> lower
-    _ -> panic "range without lower bound" -- should never happen
+    _                   -> panic "range without lower bound" -- should never happen
 
 rangeGeq :: Integer -> NonnegRange
 rangeGeq n =

src/PostgREST/Types.hs

@@ -1,30 +1,66 @@
-{-# LANGUAGE DuplicateRecordFields    #-}
+{-|
+Module      : PostgREST.Types
+Description : PostgREST common types and functions used by the rest of the modules
+-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
 module PostgREST.Types where
-import           Protolude
+
+import qualified Data.Aeson               as JSON
+import qualified Data.ByteString          as BS
+import qualified Data.ByteString.Internal as BS (c2w)
+import qualified Data.ByteString.Lazy     as BL
+import qualified Data.CaseInsensitive     as CI
+import qualified Data.HashMap.Strict      as M
+import qualified Data.Set                 as S
 import qualified GHC.Show
-import qualified Data.Aeson           as JSON
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.CaseInsensitive as CI
-import qualified Data.HashMap.Strict  as M
-import qualified Data.Set                  as S
-import           Data.Tree
-import           PostgREST.RangeQuery (NonnegRange)
-import           Network.HTTP.Types.Header (hContentType, Header)
+
+import Network.HTTP.Types.Header (Header, hContentType)
+
+import Data.Tree
+
+import PostgREST.RangeQuery (NonnegRange)
+import Protolude
 
 -- | Enumeration of currently supported response content types
-data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI
-                 | CTSingularJSON | CTOctetStream
-                 | CTAny | CTOther ByteString deriving Eq
+data ContentType = CTApplicationJSON | CTSingularJSON
+                 | CTTextCSV | CTTextPlain | CTTextHtml
+                 | CTOpenAPI | CTOctetStream
+                 | CTAny | CTOther ByteString deriving (Show, Eq)
 
-data ApiRequestError = ActionInappropriate
-                     | InvalidBody ByteString
-                     | InvalidRange
-                     | ParseRequestError Text Text
-                     | UnknownRelation
-                     | NoRelationBetween Text Text
-                     | UnsupportedVerb
-                     | InvalidFilters
-                     deriving (Show, Eq)
+-- | Convert from ContentType to a full HTTP Header
+toHeader :: ContentType -> Header
+toHeader ct = (hContentType, toMime ct <> "; charset=utf-8")
+
+-- | Convert from ContentType to a ByteString representing the mime type
+toMime :: ContentType -> ByteString
+toMime CTApplicationJSON = "application/json"
+toMime CTTextCSV         = "text/csv"
+toMime CTTextPlain       = "text/plain"
+toMime CTTextHtml        = "text/html"
+toMime CTOpenAPI         = "application/openapi+json"
+toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
+toMime CTOctetStream     = "application/octet-stream"
+toMime CTAny             = "*/*"
+toMime (CTOther ct)      = ct
+
+-- | Convert from ByteString to ContentType. Warning: discards MIME parameters
+decodeContentType :: BS.ByteString -> ContentType
+decodeContentType ct = case BS.takeWhile (/= BS.c2w ';') ct of
+  "application/json"                  -> CTApplicationJSON
+  "text/csv"                          -> CTTextCSV
+  "text/plain"                        -> CTTextPlain
+  "text/html"                         -> CTTextHtml
+  "application/openapi+json"          -> CTOpenAPI
+  "application/vnd.pgrst.object+json" -> CTSingularJSON
+  "application/vnd.pgrst.object"      -> CTSingularJSON
+  "application/octet-stream"          -> CTOctetStream
+  "*/*"                               -> CTAny
+  ct'                                 -> CTOther ct'
+
+-- | ContentTypes that can get a raw/unwrapped response
+rawContentTypes :: [ContentType]
+rawContentTypes = [CTOctetStream, CTTextPlain, CTTextHtml]
 
 data PreferResolution = MergeDuplicates | IgnoreDuplicates deriving Eq
 instance Show PreferResolution where
@@ -77,6 +113,34 @@ instance Ord ProcDescription where
     | name1 == name2 && length args1 > length args2  = GT
     | otherwise = (name1, des1, args1, rt1, vol1) `compare` (name2, des2, args2, rt2, vol2)
 
+{-|
+  Search a pg procedure by its parameters. Since a function can be overloaded, the name is not enough to find it.
+  An overloaded function can have a different volatility or even a different return type.
+-}
+findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> M.HashMap Text [ProcDescription] -> Maybe ProcDescription
+findProc qi payloadKeys paramsAsSingleObject allProcs =
+  case M.lookup (qiName qi) allProcs of
+    Nothing     -> Nothing
+    Just [proc] -> Just proc           -- if it's not an overloaded function then immediately get the ProcDescription
+    Just procs  -> find matches procs  -- Handle overloaded functions case
+  where
+    matches proc =
+      if paramsAsSingleObject
+        -- if the arg is not of json type let the db give the err
+        then length (pdArgs proc) == 1
+        else payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> pdArgs proc)
+
+{-|
+  Search the procedure parameters by matching them with the specified keys.
+  If the key doesn't match a parameter, a parameter with a default type "text" is assumed.
+-}
+specifiedProcArgs :: S.Set FieldName -> Maybe ProcDescription -> [PgArg]
+specifiedProcArgs keys proc =
+  let
+    args = maybe [] pdArgs proc
+  in
+  (\k -> fromMaybe (PgArg k "text" True) (find ((==) k . pgaName) args)) <$> S.toList keys
+
 type Schema = Text
 type TableName = Text
 type SqlQuery = Text
@@ -89,12 +153,15 @@ data Table = Table {
 , tableInsertable  :: Bool
 } deriving (Show, Ord)
 
+instance Eq Table where
+  Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
+
 newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
 
 data Column =
     Column {
       colTable       :: Table
-    , colName        :: Text
+    , colName        :: FieldName
     , colDescription :: Maybe Text
     , colPosition    :: Int32
     , colNullable    :: Bool
@@ -107,6 +174,9 @@ data Column =
     , colFK          :: Maybe ForeignKey
     } deriving (Show, Ord)
 
+instance Eq Column where
+  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
+
 -- | A view column that refers to a table column
 type Synonym = (Column, ViewColumn)
 type ViewColumn = Column
@@ -132,6 +202,10 @@ data OrderTerm = OrderTerm {
 , otNullOrder :: Maybe OrderNulls
 } deriving (Show, Eq)
 
+{-|
+  Represents a pg identifier with a prepended schema name "schema.table"
+  When qiSchema is "", the schema is defined by the pg search_path
+-}
 data QualifiedIdentifier = QualifiedIdentifier {
   qiSchema :: Schema
 , qiName   :: TableName
@@ -149,40 +223,42 @@ data RelationType = Child | Parent | Many | Root deriving (Show, Eq)
   TODO merge relColumns and relFColumns to a tuple or Data.Bimap
 -}
 data Relation = Relation {
-  relTable    :: Table
-, relColumns  :: [Column]
-, relFTable   :: Table
-, relFColumns :: [Column]
-, relType     :: RelationType
+  relTable     :: Table
+, relColumns   :: [Column]
+, relFTable    :: Table
+, relFColumns  :: [Column]
+, relType      :: RelationType
 -- The Link attrs are used when RelationType == Many
-, relLinkTable   :: Maybe Table
-, relLinkCols1   :: Maybe [Column]
-, relLinkCols2   :: Maybe [Column]
+, relLinkTable :: Maybe Table
+, relLinkCols1 :: Maybe [Column]
+, relLinkCols2 :: Maybe [Column]
 } deriving (Show, Eq)
 
--- | Cached attributes of a JSON payload
-data PayloadJSON = PayloadJSON {
--- | This is the raw ByteString that comes from the request body.
--- We cache this instead of an Aeson Value because it was detected that for large payloads the encoding
--- had high memory usage, see #1005 for more details
-  pjRaw     :: BL.ByteString
-, pjType    :: PJType
--- | Keys of the object or if it's an array these keys are guaranteed to be the same across all its objects
-, pjKeys    :: S.Set Text
-} deriving (Show, Eq)
+isSelfJoin :: Relation -> Bool
+isSelfJoin r = relType r /= Root && relTable r == relFTable r
+
+data PayloadJSON =
+  -- | Cached attributes of a JSON payload
+  ProcessedJSON {
+    -- | This is the raw ByteString that comes from the request body.
+    -- We cache this instead of an Aeson Value because it was detected that for large payloads the encoding
+    -- had high memory usage, see #1005 for more details
+    pjRaw  :: BL.ByteString
+  , pjType :: PJType
+    -- | Keys of the object or if it's an array these keys are guaranteed to be the same across all its objects
+  , pjKeys :: S.Set Text
+  }|
+  RawJSON {
+    pjRaw  :: BL.ByteString
+  } deriving (Show, Eq)
 
 data PJType = PJArray { pjaLength :: Int } | PJObject deriving (Show, Eq)
 
--- | e.g. whether it is []/{} or not
-pjIsEmpty :: PayloadJSON -> Bool
-pjIsEmpty (PayloadJSON _ PJObject keys) = S.size keys == 0
-pjIsEmpty (PayloadJSON _ (PJArray l) _) = l == 0
-
 data Proxy = Proxy {
-  proxyScheme     :: Text
-, proxyHost       :: Text
-, proxyPort       :: Integer
-, proxyPath       :: Text
+  proxyScheme :: Text
+, proxyHost   :: Text
+, proxyPort   :: Integer
+, proxyPath   :: Text
 } deriving (Show, Eq)
 
 type Operator = Text
@@ -227,8 +303,8 @@ type ListVal = [Text]
 
 data LogicOperator = And | Or deriving Eq
 instance Show LogicOperator where
-  show And  = "AND"
-  show Or = "OR"
+  show And = "AND"
+  show Or  = "OR"
 {-|
   Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
 
@@ -283,39 +359,48 @@ type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe RelationDetail)
 -- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path ["clients", "projects"]
 type EmbedPath = [Text]
 data Filter = Filter { field::Field, opExpr::OpExpr } deriving (Show, Eq)
-data JoinCondition = JoinCondition (QualifiedIdentifier, Maybe Alias, FieldName)
-                                   (QualifiedIdentifier, Maybe Alias, FieldName) deriving (Show, Eq)
+data JoinCondition = JoinCondition (QualifiedIdentifier, FieldName)
+                                   (QualifiedIdentifier, FieldName) deriving (Show, Eq)
 
-data ReadQuery = Select { select::[SelectItem], from::[TableName], where_::[LogicTree], joinConditions::[JoinCondition], order::[OrderTerm], range_::NonnegRange } deriving (Show, Eq)
-data MutateQuery = Insert { in_::TableName, insPkCols::[Text], qPayload::PayloadJSON, onConflict:: Maybe PreferResolution, where_::[LogicTree], returning::[FieldName] }
-                 | Delete { in_::TableName, where_::[LogicTree], returning::[FieldName] }
-                 | Update { in_::TableName, qPayload::PayloadJSON, where_::[LogicTree], returning::[FieldName] } deriving (Show, Eq)
-type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail, Depth))
+data ReadQuery = Select {
+    select         :: [SelectItem]
+  , from           :: TableName
+-- | A table alias is used in case of self joins
+  , fromAlias      :: Maybe Alias
+-- | Only used for Many to Many joins. Parent and Child joins use explicit joins.
+  , implicitJoins  :: [TableName]
+  , where_         :: [LogicTree]
+  , joinConditions :: [JoinCondition]
+  , order          :: [OrderTerm]
+  , range_         :: NonnegRange
+} deriving (Show, Eq)
+
+data MutateQuery =
+  Insert {
+    in_        :: TableName
+  , insCols    :: S.Set FieldName
+  , onConflict :: Maybe (PreferResolution, [FieldName])
+  , where_     :: [LogicTree]
+  , returning  :: [FieldName]
+  }|
+  Update {
+    in_       :: TableName
+  , updCols   :: S.Set FieldName
+  , where_    :: [LogicTree]
+  , returning :: [FieldName]
+  }|
+  Delete {
+    in_       :: TableName
+  , where_    :: [LogicTree]
+  , returning :: [FieldName]
+  } deriving (Show, Eq)
+
+data DbRequest = DbRead ReadRequest | DbMutate MutateRequest
 type ReadRequest = Tree ReadNode
+type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail, Depth))
 -- Depth of the ReadRequest tree
 type Depth = Integer
 type MutateRequest = MutateQuery
-data DbRequest = DbRead ReadRequest | DbMutate MutateRequest
-
-instance Eq Table where
-  Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
-
-instance Eq Column where
-  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
-
--- | Convert from ContentType to a full HTTP Header
-toHeader :: ContentType -> Header
-toHeader ct = (hContentType, toMime ct <> "; charset=utf-8")
-
--- | Convert from ContentType to a ByteString representing the mime type
-toMime :: ContentType -> ByteString
-toMime CTApplicationJSON = "application/json"
-toMime CTTextCSV         = "text/csv"
-toMime CTOpenAPI         = "application/openapi+json"
-toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
-toMime CTOctetStream     = "application/octet-stream"
-toMime CTAny             = "*/*"
-toMime (CTOther ct)      = ct
 
 data PgVersion = PgVersion {
   pgvNum  :: Int32
@@ -327,7 +412,10 @@ instance Ord PgVersion where
 
 -- | Tells the minimum PostgreSQL version required by this version of PostgREST
 minimumPgVersion :: PgVersion
-minimumPgVersion = PgVersion 90400 "9.4"
+minimumPgVersion = pgVersion94
+
+pgVersion94 :: PgVersion
+pgVersion94 = PgVersion 90400 "9.4"
 
 pgVersion95 :: PgVersion
 pgVersion95 = PgVersion 90500 "9.5"
@@ -338,6 +426,9 @@ pgVersion96 = PgVersion 90600 "9.6"
 pgVersion100 :: PgVersion
 pgVersion100 = PgVersion 100000 "10"
 
+pgVersion112 :: PgVersion
+pgVersion112 = PgVersion 110002 "11.2"
+
 sourceCTEName :: SqlFragment
 sourceCTEName = "pg_source"
 
@@ -345,3 +436,12 @@ sourceCTEName = "pg_source"
 type JSPath = [JSPathExp]
 -- | jspath expression, e.g. .property, .property[0] or ."property-dash"
 data JSPathExp = JSPKey Text | JSPIdx Int deriving (Eq, Show)
+
+
+
+-- | Current database connection status data ConnectionStatus
+data ConnectionStatus
+  = NotConnected
+  | Connected PgVersion
+  | FatalConnectionError Text
+  deriving (Eq, Show)

stack.yaml

@@ -1,18 +1,18 @@
-resolver: lts-9.6
+# stack.yaml is used for circle-ci tests. Profiling build fails on circleci
+# with GHC 8.6, so we build with 8.4 for now.
+
+resolver: lts-12.26
 extra-deps:
-  - configurator-ng-0.0.0.1
-  - critbit-0.2.0.0
-  - hjsonpointer-1.1.1
-  - hjsonschema-1.5.0.1
-  - Ranged-sets-0.3.0
-  - protolude-0.2.2
-  - hasql-1.3
-  - hasql-pool-0.5
-  - hasql-transaction-0.7
-  - text-builder-0.5.1.1
-  - jose-0.7.0.0
-  - postgresql-libpq-0.9.4.1
+- Ranged-sets-0.4.0
+- configurator-pg-0.1.0.3
+- http-types-0.12.3
+- hasql-1.4
+- hasql-pool-0.5.1
+- hasql-transaction-0.7.2
+- text-builder-0.6.5.1
+- deferred-folds-0.9.10.1
+- primitive-0.6.4.0
 ghc-options:
   postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints
 nix:
-  packages: [postgresql, zlib]
+  packages: [pcre, pkgconfig, postgresql, zlib]

test/Feature/AndOrParamsSpec.hs

@@ -1,13 +1,14 @@
 module Feature.AndOrParamsSpec where
-import Test.Hspec
-import Test.Hspec.Wai
-import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
 
 import Network.Wai (Application)
 
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import Protolude  hiding (get)
 import SpecHelper
-import Protolude hiding (get)
 
 
 spec :: SpecWith Application

test/Feature/AsymmetricJwtSpec.hs

@@ -1,14 +1,14 @@
 module Feature.AsymmetricJwtSpec where
 
 -- {{{ Imports
-import Test.Hspec
-import Test.Hspec.Wai
-import Network.HTTP.Types
-
-import SpecHelper
 import Network.Wai (Application)
 
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+
 import Protolude
+import SpecHelper
 -- }}}
 
 spec :: SpecWith Application

test/Feature/AudienceJwtSecretSpec.hs

@@ -1,14 +1,14 @@
 module Feature.AudienceJwtSecretSpec where
 
 -- {{{ Imports
-import Test.Hspec
-import Test.Hspec.Wai
-import Network.HTTP.Types
-
-import SpecHelper
 import Network.Wai (Application)
 
-import Protolude hiding (get)
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+
+import Protolude  hiding (get)
+import SpecHelper
 -- }}}
 
 spec :: SpecWith Application
@@ -44,4 +44,4 @@ spec = describe "test handling of aud claims in JWT" $ do
       `shouldRespondWith` 200
 
   it "requests without JWT token should work" $
-    get "/has_count_column" `shouldRespondWith` 200 
+    get "/has_count_column" `shouldRespondWith` 200

test/Feature/AuthSpec.hs

@@ -1,26 +1,36 @@
 module Feature.AuthSpec where
 
-import Text.Heredoc
+import Network.Wai (Application)
+
+import Network.HTTP.Types
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
+import Text.Heredoc
 
+import PostgREST.Types (PgVersion, pgVersion112)
+import Protolude       hiding (get)
 import SpecHelper
-import Network.Wai (Application)
 
-import Protolude hiding (get)
-
-spec :: SpecWith Application
-spec = describe "authorization" $ do
+spec :: PgVersion -> SpecWith Application
+spec actualPgVersion = describe "authorization" $ do
   let single = ("Accept","application/vnd.pgrst.object+json")
 
   it "denies access to tables that anonymous does not own" $
-    get "/authors_only" `shouldRespondWith` [json| {
+    get "/authors_only" `shouldRespondWith` (
+        if actualPgVersion >= pgVersion112 then
+        [json| {
+          "hint":null,
+          "details":null,
+          "code":"42501",
+          "message":"permission denied for table authors_only"} |]
+           else
+        [json| {
           "hint":null,
           "details":null,
           "code":"42501",
           "message":"permission denied for relation authors_only"} |]
+                                            )
       { matchStatus = 401
       , matchHeaders = ["WWW-Authenticate" <:> "Bearer"]
       }
@@ -28,11 +38,20 @@ spec = describe "authorization" $ do
   it "denies access to tables that postgrest_test_author does not own" $
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA" in
     request methodGet "/private_table" [auth] ""
-      `shouldRespondWith` [json| {
+      `shouldRespondWith` (
+        if actualPgVersion >= pgVersion112 then
+        [json| {
+          "hint":null,
+          "details":null,
+          "code":"42501",
+          "message":"permission denied for table private_table"} |]
+           else
+        [json| {
           "hint":null,
           "details":null,
           "code":"42501",
           "message":"permission denied for relation private_table"} |]
+                          )
       { matchStatus = 403
       , matchHeaders = []
       }

test/Feature/BinaryJwtSecretSpec.hs

@@ -1,14 +1,14 @@
 module Feature.BinaryJwtSecretSpec where
 
 -- {{{ Imports
-import Test.Hspec
-import Test.Hspec.Wai
-import Network.HTTP.Types
-
-import SpecHelper
 import Network.Wai (Application)
 
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+
 import Protolude
+import SpecHelper
 -- }}}
 
 spec :: SpecWith Application

test/Feature/ConcurrentSpec.hs

@@ -1,20 +1,21 @@
-{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE UndecidableInstances  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Feature.ConcurrentSpec where
 
-import Control.Monad (void)
-import Control.Monad.Base
-
-import Control.Monad.Trans.Control
 import Control.Concurrent.Async (mapConcurrently)
+import Control.Monad            (void)
+import Network.Wai              (Application)
 
+import Control.Monad.Base
+import Control.Monad.Trans.Control
+
+import Network.Wai.Test        (Session)
 import Test.Hspec
-import Test.Hspec.Wai.Internal
 import Test.Hspec.Wai
+import Test.Hspec.Wai.Internal
 import Test.Hspec.Wai.JSON
-import Network.Wai.Test (Session)
-
-import Network.Wai (Application)
 
 import Protolude hiding (get)
 

test/Feature/CorsSpec.hs

@@ -1,17 +1,17 @@
 module Feature.CorsSpec where
 
 -- {{{ Imports
-import Test.Hspec
-import Test.Hspec.Wai
-import Network.Wai.Test (SResponse(simpleHeaders, simpleBody))
 import qualified Data.ByteString.Lazy as BL
 
-import SpecHelper
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (simpleBody, simpleHeaders))
 
 import Network.HTTP.Types
-import Network.Wai (Application)
+import Test.Hspec
+import Test.Hspec.Wai
 
 import Protolude
+import SpecHelper
 -- }}}
 
 spec :: SpecWith Application

test/Feature/DeleteSpec.hs

@@ -1,12 +1,12 @@
 module Feature.DeleteSpec where
 
+import Network.Wai (Application)
+
+import Network.HTTP.Types
 import Test.Hspec
 import Test.Hspec.Wai
 import Text.Heredoc
 
-import Network.HTTP.Types
-import Network.Wai (Application)
-
 import Protolude hiding (get)
 
 spec :: SpecWith Application

test/Feature/ExtraSearchPathSpec.hs

@@ -1,14 +1,13 @@
 module Feature.ExtraSearchPathSpec where
 
+import Network.HTTP.Types
+import Network.Wai         (Application)
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
-
-import SpecHelper
-import Network.Wai (Application)
 
 import Protolude
+import SpecHelper
 
 spec :: SpecWith Application
 spec = describe "extra search path" $ do

test/Feature/InsertSpec.hs

@@ -1,28 +1,27 @@
 module Feature.InsertSpec where
 
-import Test.Hspec hiding (pendingWith)
+import qualified Data.Aeson as JSON
+
+import Control.Monad          (replicateM_, void)
+import Data.List              (lookup)
+import Data.Maybe             (fromJust)
+import Network.Wai            (Application)
+import Network.Wai.Test       (SResponse (simpleBody, simpleHeaders, simpleStatus))
+import Test.Hspec             hiding (pendingWith)
+import Test.Hspec.Wai.Matcher (bodyEquals)
+import TestTypes              (CompoundPK (..), IncPK (..))
+
+import Network.HTTP.Types
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Test.Hspec.Wai.Matcher (bodyEquals)
-import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
+import Text.Heredoc
 
+import PostgREST.Types (PgVersion, pgVersion112)
+import Protolude       hiding (get)
 import SpecHelper
 
-import qualified Data.Aeson as JSON
-import Data.List (lookup)
-import Data.Maybe (fromJust)
-import Text.Heredoc
-import Network.HTTP.Types.Header
-import Network.HTTP.Types
-import Control.Monad (replicateM_, void)
-
-import TestTypes(IncPK(..), CompoundPK(..))
-import Network.Wai (Application)
-
-import Protolude hiding (get)
-
-spec :: SpecWith Application
-spec = do
+spec :: PgVersion -> SpecWith Application
+spec actualPgVersion = do
   describe "Posting new record" $ do
     context "disparate json types" $ do
       it "accepts disparate json types" $ do
@@ -51,9 +50,22 @@ spec = do
 
     context "non uniform json array" $ do
       it "rejects json array that isn't exclusivily composed of objects" $
-        post "/articles" [json| [{"id": 100, "body": "xxxxx"}, 123, "xxxx", {"id": 111, "body": "xxxx"}] |] `shouldRespondWith` 400
+        post "/articles"
+             [json| [{"id": 100, "body": "xxxxx"}, 123, "xxxx", {"id": 111, "body": "xxxx"}] |]
+        `shouldRespondWith`
+             [json| {"message":"All object keys must match"} |]
+             { matchStatus  = 400
+             , matchHeaders = [matchContentTypeJson]
+             }
+
       it "rejects json array that has objects with different keys" $
-        post "/articles" [json| [{"id": 100, "body": "xxxxx"}, {"id": 111, "body": "xxxx", "owner": "me"}] |] `shouldRespondWith` 400
+        post "/articles"
+             [json| [{"id": 100, "body": "xxxxx"}, {"id": 111, "body": "xxxx", "owner": "me"}] |]
+        `shouldRespondWith`
+             [json| {"message":"All object keys must match"} |]
+             { matchStatus  = 400
+             , matchHeaders = [matchContentTypeJson]
+             }
 
     context "requesting full representation" $ do
       it "includes related data after insert" $
@@ -103,11 +115,13 @@ spec = do
             incNullableStr record `shouldBe` Nothing
 
       context "into a table with simple pk" $
-        it "fails with 400 and error" $ do
-          p <- post "/simple_pk" [json| { "extra":"foo"} |]
-          liftIO $ do
-            simpleStatus p `shouldBe` badRequest400
-            isErrorFormat (simpleBody p) `shouldBe` True
+        it "fails with 400 and error" $
+          post "/simple_pk" [json| { "extra":"foo"} |]
+          `shouldRespondWith`
+          [json|{"hint":null,"details":"Failing row contains (null, foo).","code":"23502","message":"null value in column \"k\" violates not-null constraint"}|]
+          { matchStatus  = 400
+          , matchHeaders = [matchContentTypeJson]
+          }
 
       context "into a table with no pk" $ do
         it "succeeds with 201 and a link including all fields" $ do
@@ -181,11 +195,13 @@ spec = do
           lookup hLocation (simpleHeaders p) `shouldBe` Nothing
 
     context "with invalid json payload" $
-      it "fails with 400 and error" $ do
-        p <- post "/simple_pk" "}{ x = 2"
-        liftIO $ do
-          simpleStatus p `shouldBe` badRequest400
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "fails with 400 and error" $
+        post "/simple_pk" "}{ x = 2"
+        `shouldRespondWith`
+        [json|{"message":"Error in $: Failed reading: not a valid json value"}|]
+        { matchStatus  = 400
+        , matchHeaders = [matchContentTypeJson]
+        }
 
     context "with valid json payload" $
       it "succeeds and returns 201 created" $
@@ -193,7 +209,12 @@ spec = do
 
     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
+        post "/simple_pk" [json| { "k":"k1", "extra":"e1" } |]
+          `shouldRespondWith`
+          [json|{"hint":null,"details":"Key (k)=(k1) already exists.","code":"23505","message":"duplicate key value violates unique constraint \"contacts_pkey\""}|]
+          { matchStatus  = 409
+          , matchHeaders = [matchContentTypeJson]
+          }
 
     context "attempting to insert a row with conflicting unique constraint" $
       it "fails returning a 409 Conflict" $
@@ -222,12 +243,23 @@ spec = do
           , matchHeaders = ["Location" <:> location]
           }
 
-    context "empty object" $
-      it "successfully populates table with all-default columns" $
+    context "empty objects" $ do
+      it "successfully inserts a row with all-default columns" $ do
         post "/items" "{}" `shouldRespondWith` ""
           { matchStatus  = 201
           , matchHeaders = []
           }
+        post "/items" "[{}]" `shouldRespondWith` ""
+          { matchStatus  = 201
+          , matchHeaders = []
+          }
+
+      it "successfully inserts two rows with all-default columns" $
+        post "/items" "[{}, {}]" `shouldRespondWith` ""
+          { matchStatus  = 201
+          , matchHeaders = []
+          }
+
     context "table with limited privileges" $ do
       it "succeeds if correct select is applied" $
         request methodPost "/limited_article_stars?select=article_id,user_id" [("Prefer", "return=representation")]
@@ -237,20 +269,75 @@ spec = do
           }
       it "fails if more columns are selected" $
         request methodPost "/limited_article_stars?select=article_id,user_id,created_at" [("Prefer", "return=representation")]
-          [json| {"article_id": 2, "user_id": 2} |] `shouldRespondWith`
-          [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+          [json| {"article_id": 2, "user_id": 2} |] `shouldRespondWith` (
+        if actualPgVersion >= pgVersion112 then
+        [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for view limited_article_stars"}|]
+           else
+        [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+                                                                        )
           { matchStatus  = 401
           , matchHeaders = []
           }
       it "fails if select is not specified" $
         request methodPost "/limited_article_stars" [("Prefer", "return=representation")]
-          [json| {"article_id": 3, "user_id": 1} |] `shouldRespondWith` [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+          [json| {"article_id": 3, "user_id": 1} |] `shouldRespondWith` (
+        if actualPgVersion >= pgVersion112 then
+        [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for view limited_article_stars"}|]
+           else
+        [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+                                                                        )
           { matchStatus  = 401
           , matchHeaders = []
           }
 
-  describe "CSV insert" $ do
+    context "POST with ?columns parameter" $ do
+      it "ignores json keys not included in ?columns" $ do
+        request methodPost "/articles?columns=id,body" [("Prefer", "return=representation")]
+          [json| {"id": 200, "body": "xxx", "smth": "here", "other": "stuff", "fake_id": 13} |] `shouldRespondWith`
+          [json|[{"id": 200, "body": "xxx", "owner": "postgrest_test_anonymous"}]|]
+          { matchStatus  = 201
+          , matchHeaders = [] }
+        request methodPost "/articles?columns=id,body&select=id,body" [("Prefer", "return=representation")]
+          [json| [
+            {"id": 201, "body": "yyy", "smth": "here", "other": "stuff", "fake_id": 13},
+            {"id": 202, "body": "zzz", "garbage": "%%$&", "kkk": "jjj"},
+            {"id": 203, "body": "aaa", "hey": "ho"} ]|] `shouldRespondWith`
+          [json|[
+            {"id": 201, "body": "yyy"},
+            {"id": 202, "body": "zzz"},
+            {"id": 203, "body": "aaa"} ]|]
+          { matchStatus  = 201
+          , matchHeaders = [] }
 
+      -- TODO parse columns error message needs to be improved
+      it "disallows blank ?columns" $
+        post "/articles?columns="
+          [json|[
+            {"id": 204, "body": "yyy"},
+            {"id": 205, "body": "zzz"}]|]
+          `shouldRespondWith`
+          [json|  {"details":"unexpected end of input expecting field name (* or [a..z0..9_])","message":"\"failed to parse columns parameter ()\" (line 1, column 1)"} |]
+          { matchStatus  = 400
+          , matchHeaders = []
+          }
+
+      it "disallows array elements that are not json objects" $
+        post "/articles?columns=id,body"
+          [json|[
+            {"id": 204, "body": "yyy"},
+            333,
+            "asdf",
+            {"id": 205, "body": "zzz"}]|] `shouldRespondWith`
+          [json|{
+              "code": "22023",
+              "details": null,
+              "hint": null,
+              "message": "argument of json_populate_recordset must be an array of objects"}|]
+          { matchStatus  = 400
+          , matchHeaders = []
+          }
+
+  describe "CSV insert" $ do
     context "disparate csv types" $
       it "succeeds with multipart response" $ do
         pendingWith "Decide on what to do with CSV insert"
@@ -297,11 +384,13 @@ spec = do
           }
 
     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 $ do
-          simpleStatus p `shouldBe` badRequest400
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "fails for too few" $
+        request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz"
+        `shouldRespondWith`
+        [json|{"message":"All lines must have same number of fields"}|]
+        { matchStatus  = 400
+        , matchHeaders = [matchContentTypeJson]
+        }
 
     context "with unicode values" $
       it "succeeds and returns usable location header" $ do
@@ -317,22 +406,20 @@ spec = do
         r <- get location
         liftIO $ simpleBody r `shouldBe` "["<>payload<>"]"
 
-
   describe "Patching record" $ do
-
     context "to unknown uri" $
-      it "gives a 404" $
+      it "indicates no table found by returning 404" $
         request methodPatch "/fake" []
           [json| { "real": false } |]
             `shouldRespondWith` 404
 
     context "on an empty table" $
-      it "indicates no records found to update" $
+      it "indicates no records found to update by returning 404" $
         request methodPatch "/empty_table" []
           [json| { "extra":20 } |]
           `shouldRespondWith` ""
-          { matchStatus  = 204,
-            matchHeaders = ["Content-Range" <:> "*/*"]
+          { matchStatus  = 404,
+            matchHeaders = []
           }
 
     context "in a nonempty table" $ do
@@ -359,10 +446,15 @@ spec = do
           [("Prefer", "return=representation")] [json| { "id":999999 } |]
           `shouldRespondWith` "[]"
           {
-            matchStatus  = 200,
-            matchHeaders = ["Content-Range" <:> "*/*"]
+            matchStatus  = 404,
+            matchHeaders = []
           }
 
+      it "gives a 404 when no rows updated" $
+        request methodPatch "/items?id=eq.99999999" []
+          [json| { "id": 42 } |]
+            `shouldRespondWith` 404
+
       it "returns updated object as array when return=rep" $
         request methodPatch "/items?id=eq.2"
           [("Prefer", "return=representation")] [json| { "id":2 } |]
@@ -390,15 +482,26 @@ spec = do
           [json| [{ a: "keepme", b: null }] |]
           { matchHeaders = [matchContentTypeJson] }
 
-      it "can update based on a computed column" $
-        request methodPatch
-          "/items?always_true=eq.false"
-          [("Prefer", "return=representation")]
-          [json| { id: 100 } |]
-          `shouldRespondWith` "[]"
-          { matchStatus  = 200,
-            matchHeaders = ["Content-Range" <:> "*/*"]
-          }
+      context "filtering by a computed column" $ do
+        it "is successful" $
+          request methodPatch
+            "/items?is_first=eq.true"
+            [("Prefer", "return=representation")]
+            [json| { id: 100 } |]
+            `shouldRespondWith` [json| [{ id: 100 }] |]
+            { matchStatus  = 200,
+              matchHeaders = [matchContentTypeJson, "Content-Range" <:> "0-0/*"]
+            }
+
+        it "indicates no records updated by returning 404" $
+          request methodPatch
+            "/items?always_true=eq.false"
+            [("Prefer", "return=representation")]
+            [json| { id: 100 } |]
+            `shouldRespondWith` "[]"
+            { matchStatus  = 404,
+              matchHeaders = []
+            }
 
       it "can provide a representation" $ do
         _ <- post "/items"
@@ -427,21 +530,21 @@ spec = do
             matchHeaders = ["Content-Range" <:> "*/*"]
           }
 
-        get "/items" `shouldRespondWith`
-          [json|[{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15},{id:16},{"id":2},{"id":1}]|]
-          { matchHeaders = [matchContentTypeJson] }
+        request methodPatch "/items" [] [json| [{}] |]
+          `shouldRespondWith` ""
+          {
+            matchStatus  = 204,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
 
-      it "makes no updates and and returns 200, when patching with an empty json object and return=rep" $ do
+      it "makes no updates and and returns 200, when patching with an empty json object and return=rep" $
         request methodPatch "/items" [("Prefer", "return=representation")] [json| {} |]
           `shouldRespondWith` "[]"
           {
             matchStatus  = 200,
             matchHeaders = ["Content-Range" <:> "*/*"]
           }
-        get "/items" `shouldRespondWith`
-          [json| [{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15},{id:16},{"id":2},{"id":1}] |]
-          { matchHeaders = [matchContentTypeJson] }
-  
+
     context "with unicode values" $
       it "succeeds and returns values intact" $ do
         void $ request methodPost "/no_pk" []
@@ -453,6 +556,18 @@ spec = do
           simpleBody p `shouldBe` "["<>payload<>"]"
           simpleStatus p `shouldBe` ok200
 
+    context "PATCH with ?columns parameter" $ do
+      it "ignores json keys not included in ?columns" $
+        request methodPatch "/articles?id=eq.200&columns=body" [("Prefer", "return=representation")]
+          [json| {"body": "Some real content", "smth": "here", "other": "stuff", "fake_id": 13} |] `shouldRespondWith`
+          [json|[{"id": 200, "body": "Some real content", "owner": "postgrest_test_anonymous"}]|]
+          { matchStatus  = 200
+          , matchHeaders = [] }
+
+      it "ignores json keys and gives 404 if no record updated" $
+        request methodPatch "/articles?id=eq.2001&columns=body" [("Prefer", "return=representation")]
+          [json| {"body": "Some real content", "smth": "here", "other": "stuff", "fake_id": 13} |] `shouldRespondWith` 404
+
   describe "Row level permission" $
     it "set user_id when inserting rows" $ do
       let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.B-lReuGNDwAlU1GOC476MlO0vAt9JNoHIlxg2vwMaO0"

test/Feature/JsonOperatorSpec.hs

@@ -1,17 +1,18 @@
 module Feature.JsonOperatorSpec where
 
+import Network.Wai (Application)
+
+import Network.HTTP.Types
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
 
+import PostgREST.Types (PgVersion, pgVersion112)
+import Protolude       hiding (get)
 import SpecHelper
-import Network.Wai (Application)
 
-import Protolude hiding (get)
-
-spec :: SpecWith Application
-spec = describe "json and jsonb operators" $ do
+spec :: PgVersion -> SpecWith Application
+spec actualPgVersion = describe "json and jsonb operators" $ do
   context "Shaping response with select parameter" $ do
     it "obtains a json subfield one level with casting" $
       get "/complex_items?id=eq.1&select=settings->>foo::json" `shouldRespondWith`
@@ -52,14 +53,28 @@ spec = describe "json and jsonb operators" $ do
     -- this works fine for /rpc/unexistent requests, but for this case a 500 seems more appropriate
     it "fails when a double arrow ->> is followed with a single arrow ->" $ do
       get "/json_arr?select=data->>c->1"
-        `shouldRespondWith` [json|
+        `shouldRespondWith` (
+        if actualPgVersion >= pgVersion112 then
+        [json|
+          {"hint":"No operator matches the given name and argument types. You might need to add explicit type casts.",
+           "details":null,"code":"42883","message":"operator does not exist: text -> integer"} |]
+           else
+        [json|
           {"hint":"No operator matches the given name and argument type(s). You might need to add explicit type casts.",
            "details":null,"code":"42883","message":"operator does not exist: text -> integer"} |]
+                            )
         { matchStatus  = 404 , matchHeaders = [] }
       get "/json_arr?select=data->>c->b"
-        `shouldRespondWith` [json|
+        `shouldRespondWith` (
+        if actualPgVersion >= pgVersion112 then
+        [json|
+          {"hint":"No operator matches the given name and argument types. You might need to add explicit type casts.",
+           "details":null,"code":"42883","message":"operator does not exist: text -> unknown"} |]
+           else
+        [json|
           {"hint":"No operator matches the given name and argument type(s). You might need to add explicit type casts.",
            "details":null,"code":"42883","message":"operator does not exist: text -> unknown"} |]
+                            )
         { matchStatus  = 404 , matchHeaders = [] }
 
     context "with array index" $ do

test/Feature/NoJwtSpec.hs

@@ -1,14 +1,16 @@
 module Feature.NoJwtSpec where
 
 -- {{{ Imports
-import Test.Hspec
-import Test.Hspec.Wai
-import Network.HTTP.Types
 
-import SpecHelper
 import Network.Wai (Application)
 
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
 import Protolude
+import SpecHelper
 -- }}}
 
 spec :: SpecWith Application
@@ -18,7 +20,11 @@ spec = describe "server started without JWT secret" $ do
   it "responds with error on attempted auth" $ do
     let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA"
     request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` 500
+      `shouldRespondWith`
+      [json|{"message":"Server lacks JWT secret"}|]
+      { matchStatus  = 500
+      , matchHeaders = [ matchContentTypeJson ]
+      }
 
   it "behaves normally when user does not attempt auth" $
     request methodGet "/items" [] ""

test/Feature/NonexistentSchemaSpec.hs

@@ -1,10 +1,12 @@
 module Feature.NonexistentSchemaSpec where
 
 import Network.Wai (Application)
-import Protolude hiding (get)
+
 import Test.Hspec
 import Test.Hspec.Wai
 
+import Protolude hiding (get)
+
 spec :: SpecWith Application
 spec =
   describe "Non existent api schema" $ do

test/Feature/PgVersion95Spec.hs

@@ -1,13 +1,13 @@
 module Feature.PgVersion95Spec where
 
+import Network.Wai (Application)
+
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 
+import Protolude  hiding (get)
 import SpecHelper
-import Network.Wai (Application)
-
-import Protolude hiding (get)
 
 spec :: SpecWith Application
 spec = describe "features supported on PostgreSQL 9.5" $

test/Feature/PgVersion96Spec.hs

@@ -1,13 +1,13 @@
 module Feature.PgVersion96Spec where
 
+import Network.Wai (Application)
+
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 
+import Protolude  hiding (get)
 import SpecHelper
-import Network.Wai (Application)
-
-import Protolude hiding (get)
 
 spec :: SpecWith Application
 spec =
@@ -34,10 +34,30 @@ spec =
               "X-Test-2" <:> "key1=val1"]}
 
       it "fails when setting headers with wrong json structure" $ do
-        get "/rpc/bad_guc_headers_1" `shouldRespondWith` 500
-        get "/rpc/bad_guc_headers_2" `shouldRespondWith` 500
-        get "/rpc/bad_guc_headers_3" `shouldRespondWith` 500
-        post "/rpc/bad_guc_headers_1" [json|{}|] `shouldRespondWith` 500
+        get "/rpc/bad_guc_headers_1"
+          `shouldRespondWith`
+          [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]
+          { matchStatus  = 500
+          , matchHeaders = [ matchContentTypeJson ]
+          }
+        get "/rpc/bad_guc_headers_2"
+          `shouldRespondWith`
+          [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]
+          { matchStatus  = 500
+          , matchHeaders = [ matchContentTypeJson ]
+          }
+        get "/rpc/bad_guc_headers_3"
+          `shouldRespondWith`
+          [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]
+          { matchStatus  = 500
+          , matchHeaders = [ matchContentTypeJson ]
+          }
+        post "/rpc/bad_guc_headers_1" [json|{}|]
+          `shouldRespondWith`
+          [json|{"message":"response.headers guc must be a JSON array composed of objects with a single key and a string value"}|]
+          { matchStatus  = 500
+          , matchHeaders = [ matchContentTypeJson ]
+          }
 
       it "can set the same http header twice" $
         get "/rpc/set_cookie_twice"

test/Feature/ProxySpec.hs

@@ -1,12 +1,10 @@
 module Feature.ProxySpec where
 
-import Test.Hspec
-
-import SpecHelper
-
 import Network.Wai (Application)
+import Test.Hspec  hiding (pendingWith)
 
 import Protolude
+import SpecHelper
 
 spec :: SpecWith Application
 spec =

test/Feature/QueryLimitedSpec.hs

@@ -1,14 +1,15 @@
 module Feature.QueryLimitedSpec where
 
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (simpleHeaders, simpleStatus))
+
+import Network.HTTP.Types
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
-import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus))
-import SpecHelper
-import Network.Wai (Application)
 
-import Protolude hiding (get)
+import Protolude  hiding (get)
+import SpecHelper
 
 spec :: SpecWith Application
 spec =

test/Feature/QuerySpec.hs

@@ -1,16 +1,17 @@
 module Feature.QuerySpec where
 
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (simpleHeaders))
+
+import Network.HTTP.Types
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
-import Network.Wai.Test (SResponse(simpleHeaders))
 
-import SpecHelper
 import Text.Heredoc
-import Network.Wai (Application)
 
-import Protolude hiding (get)
+import Protolude  hiding (get)
+import SpecHelper
 
 spec :: SpecWith Application
 spec = do
@@ -181,7 +182,6 @@ spec = do
         { matchHeaders = [matchContentTypeJson] }
 
   describe "Shaping response with select parameter" $ do
-
     it "selectStar works in absense of parameter" $
       get "/complex_items?id=eq.3" `shouldRespondWith`
         [str|[{"id":3,"name":"Three","settings":{"foo":{"int":1,"bar":"baz"}},"arr_data":[1,2,3],"field-with_sep":1}]|]
@@ -333,6 +333,9 @@ spec = do
       it "can detect fk relations through views to tables in the public schema" $
         get "/consumers_view?select=*,orders_view(*)" `shouldRespondWith` 200
 
+      it "can detect fk relations through materialized views to tables in the public schema" $
+        get "/materialized_projects?select=*,users(*)" `shouldRespondWith` 200
+
       it "can request parent without specifying primary key" $
         get "/articleStars?select=createdAt,article(owner),user(name)&limit=1" `shouldRespondWith`
           [json|[{"createdAt":"2015-12-08T04:22:57.472738","article":{"owner": "postgrest_test_authenticator"},"user":{"name": "Angela Martin"}}]|]
@@ -433,22 +436,33 @@ spec = do
              {"number_of_projects":2,"client":{"name":"Apple"}}] |]
           { matchHeaders = [matchContentTypeJson] }
 
+      it "can embed a view that has a subselect containing a select in a where" $
+        get "/authors_w_entities?select=name,entities,books(title)&id=eq.1" `shouldRespondWith`
+          [json| [{"name":"George Orwell","entities":[3, 4],"books":[{"title":"1984"}]}] |]
+          { matchHeaders = [matchContentTypeJson] }
+
     describe "path fixed" $ do
       it "works when requesting children 2 levels" $
-        get "/clients?id=eq.1&select=id,projects:projects.client_id(id,tasks(id))" `shouldRespondWith`
+        get "/clients?id=eq.1&select=id,projects:projects%2Bclient_id(id,tasks(id))" `shouldRespondWith`
           [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]
           { matchHeaders = [matchContentTypeJson] }
 
       it "works with parent relation" $
-        get "/message?select=id,body,sender:person.sender(name),recipient:person.recipient(name)&id=lt.4" `shouldRespondWith`
+        get "/message?select=id,body,sender:person%2Bsender(name),recipient:person%2Brecipient(name)&id=lt.4" `shouldRespondWith`
           [json|
             [{"id":1,"body":"Hello Jane","sender":{"name":"John"},"recipient":{"name":"Jane"}},
              {"id":2,"body":"Hi John","sender":{"name":"Jane"},"recipient":{"name":"John"}},
              {"id":3,"body":"How are you doing?","sender":{"name":"John"},"recipient":{"name":"Jane"}}] |]
           { matchHeaders = [matchContentTypeJson] }
 
+      it "fails with an unknown relation" $
+        get "/message?select=id,sender:person.space(name)&id=lt.4" `shouldRespondWith`
+          [json|{"message":"Could not find foreign keys between these entities, No relation found between message and person"}|]
+          { matchStatus = 400
+          , matchHeaders = [matchContentTypeJson] }
+
       it "works with a parent view relation" $
-        get "/message?select=id,body,sender:person_detail.sender(name,sent),recipient:person_detail.recipient(name,received)&id=lt.4" `shouldRespondWith`
+        get "/message?select=id,body,sender:person_detail%2Bsender(name,sent),recipient:person_detail%2Brecipient(name,received)&id=lt.4" `shouldRespondWith`
           [json|
             [{"id":1,"body":"Hello Jane","sender":{"name":"John","sent":2},"recipient":{"name":"Jane","received":2}},
              {"id":2,"body":"Hi John","sender":{"name":"Jane","sent":1},"recipient":{"name":"John","received":1}},
@@ -456,10 +470,19 @@ spec = do
           { matchHeaders = [matchContentTypeJson] }
 
       it "works with many<->many relation" $
-        get "/tasks?select=id,users:users.users_tasks(id)" `shouldRespondWith`
+        get "/tasks?select=id,users:users%2Busers_tasks(id)" `shouldRespondWith`
           [json|[{"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":[]}]|]
           { matchHeaders = [matchContentTypeJson] }
 
+      describe "old dot '.' symbol, deprecated" $
+        it "still works" $ do
+          get "/clients?id=eq.1&select=id,projects:projects.client_id(id,tasks(id))" `shouldRespondWith`
+            [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]
+            { matchHeaders = [matchContentTypeJson] }
+          get "/tasks?select=id,users:users.users_tasks(id)" `shouldRespondWith`
+            [json|[{"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":[]}]|]
+            { matchHeaders = [matchContentTypeJson] }
+
     describe "aliased embeds" $ do
       it "works with child relation" $
         get "/space?select=id,zones:zone(id,name),stores:zone(id,name)&zones.zone_type_id=eq.2&stores.zone_type_id=eq.3" `shouldRespondWith`
@@ -528,7 +551,7 @@ spec = do
             { matchHeaders = [matchContentTypeJson] }
 
         it "embeds childs recursively" $
-          get "/family_tree?id=eq.1&select=id,name, childs:family_tree.parent(id,name,childs:family_tree.parent(id,name))" `shouldRespondWith`
+          get "/family_tree?id=eq.1&select=id,name, childs:family_tree%2Bparent(id,name,childs:family_tree%2Bparent(id,name))" `shouldRespondWith`
             [json|[{
               "id": "1", "name": "Parental Unit", "childs": [
                 { "id": "2", "name": "Kid One", "childs": [ { "id": "4", "name": "Grandkid One" } ] },
@@ -537,7 +560,7 @@ spec = do
             }]|] { matchHeaders = [matchContentTypeJson] }
 
         it "embeds parent and then embeds childs" $
-          get "/family_tree?id=eq.2&select=id,name,parent(id,name,childs:family_tree.parent(id,name))" `shouldRespondWith`
+          get "/family_tree?id=eq.2&select=id,name,parent(id,name,childs:family_tree%2Bparent(id,name))" `shouldRespondWith`
             [json|[{
               "id": "2", "name": "Kid One", "parent": {
                 "id": "1", "name": "Parental Unit", "childs": [ { "id": "2", "name": "Kid One" }, { "id": "3", "name": "Kid Two"} ]
@@ -560,7 +583,7 @@ spec = do
             }]|] { matchHeaders = [matchContentTypeJson] }
 
         it "embeds childs" $ do
-          get "/organizations?select=id,name,refereeds:organizations.referee(id,name)&id=eq.1" `shouldRespondWith`
+          get "/organizations?select=id,name,refereeds:organizations%2Breferee(id,name)&id=eq.1" `shouldRespondWith`
             [json|[{
               "id": 1, "name": "Referee Org",
               "refereeds": [
@@ -574,7 +597,7 @@ spec = do
                 }
               ]
             }]|] { matchHeaders = [matchContentTypeJson] }
-          get "/organizations?select=id,name,auditees:organizations.auditor(id,name)&id=eq.2" `shouldRespondWith`
+          get "/organizations?select=id,name,auditees:organizations%2Bauditor(id,name)&id=eq.2" `shouldRespondWith`
             [json|[{
               "id": 2, "name": "Auditor Org",
               "auditees": [
@@ -589,6 +612,42 @@ spec = do
               ]
             }]|] { matchHeaders = [matchContentTypeJson] }
 
+        it "embeds other relations(manager) besides the self reference" $ do
+          get "/organizations?select=name,manager(name),referee(name,manager(name),auditor(name,manager(name))),auditor(name,manager(name),referee(name,manager(name)))&id=eq.5" `shouldRespondWith`
+            [json|[{
+              "name":"Cyberdyne",
+              "manager":{"name":"Cyberdyne Manager"},
+              "referee":{
+                "name":"Acme",
+                "manager":{"name":"Acme Manager"},
+                "auditor":{
+                  "name":"Auditor Org",
+                  "manager":{"name":"Auditor Manager"}}},
+              "auditor":{
+                "name":"Umbrella",
+                "manager":{"name":"Umbrella Manager"},
+                "referee":{
+                  "name":"Referee Org",
+                  "manager":{"name":"Referee Manager"}}}
+            }]|] { matchHeaders = [matchContentTypeJson] }
+
+          get "/organizations?select=name,manager(name),auditees:organizations%2Bauditor(name,manager(name),refereeds:organizations%2Breferee(name,manager(name)))&id=eq.2" `shouldRespondWith`
+            [json|[{
+              "name":"Auditor Org",
+              "manager":{"name":"Auditor Manager"},
+              "auditees":[
+                {"name":"Acme",
+                 "manager":{"name":"Acme Manager"},
+                 "refereeds":[
+                   {"name":"Cyberdyne",
+                    "manager":{"name":"Cyberdyne Manager"}},
+                   {"name":"Oscorp",
+                    "manager":{"name":"Oscorp Manager"}}]},
+                {"name":"Umbrella",
+                 "manager":{"name":"Umbrella Manager"},
+                 "refereeds":[]}]
+            }]|] { matchHeaders = [matchContentTypeJson] }
+
   describe "ordering response" $ do
     it "by a column asc" $
       get "/items?id=lte.2&order=id.asc"
@@ -737,7 +796,11 @@ spec = do
     it "should respond an unknown accept type with 415" $
       request methodGet "/simple_pk"
               (acceptHdrs "text/unknowntype") ""
-        `shouldRespondWith` 415
+        `shouldRespondWith`
+        [json|{"message":"None of these Content-Types are available: text/unknowntype"}|]
+        { matchStatus  = 415
+        , matchHeaders = [matchContentTypeJson]
+        }
 
     it "should respond correctly to */* in accept header" $
       request methodGet "/simple_pk"
@@ -793,7 +856,6 @@ spec = do
         respHeaders `shouldSatisfy` matchHeader
           "Content-Location" "/simple_pk"
 
-
   describe "weird requests" $ do
     it "can query as normal" $ do
       get "/Escap3e;" `shouldRespondWith`
@@ -833,50 +895,39 @@ spec = do
         [json|[{":arr->ow::cast":" arrow-1 ","(inside,parens)":" parens-1 ","a.dotted.column":" dotted-1 ","  col  w  space  ":" space-1"}]|]
         { matchHeaders = [matchContentTypeJson] }
 
-  describe "binary output" $ do
-    context "on GET" $ do
-      it "can query if a single column is selected" $
-        request methodGet "/images_base64?select=img&name=eq.A.png" (acceptHdrs "application/octet-stream") ""
-          `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCC"
-          { matchStatus = 200
-          , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"]
-          }
+  context "binary output" $ do
+    it "can query if a single column is selected" $
+      request methodGet "/images_base64?select=img&name=eq.A.png" (acceptHdrs "application/octet-stream") ""
+        `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCC"
+        { matchStatus = 200
+        , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"]
+        }
 
-      it "fails if a single column is not selected" $ do
-        request methodGet "/images?select=img,name&name=eq.A.png" (acceptHdrs "application/octet-stream") ""
-          `shouldRespondWith` 406
-        request methodGet "/images?select=*&name=eq.A.png" (acceptHdrs "application/octet-stream") ""
-          `shouldRespondWith` 406
-        request methodGet "/images?name=eq.A.png" (acceptHdrs "application/octet-stream") ""
-          `shouldRespondWith` 406
+    it "can get raw output with Accept: text/plain" $
+      request methodGet "/projects?select=name&id=eq.1" (acceptHdrs "text/plain") ""
+        `shouldRespondWith` "Windows 7"
+        { matchStatus = 200
+        , matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]
+        }
 
-      it "concatenates results if more than one row is returned" $
-        request methodGet "/images_base64?select=img&name=in.(A.png,B.png)" (acceptHdrs "application/octet-stream") ""
-          `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCCiVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEX///8AAP94wDzzAAAAL0lEQVQIW2NgwAb+HwARH0DEDyDxwAZEyGAhLODqHmBRzAcn5GAS///A1IF14AAA5/Adbiiz/0gAAAAASUVORK5CYII="
-          { matchStatus = 200
-          , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"]
-          }
+    it "fails if a single column is not selected" $ do
+      request methodGet "/images?select=img,name&name=eq.A.png" (acceptHdrs "application/octet-stream") ""
+        `shouldRespondWith`
+        [json| {"message":"application/octet-stream requested but a single column was not selected"} |]
+        { matchStatus = 406
+        , matchHeaders = [matchContentTypeJson]
+        }
+      request methodGet "/images?select=*&name=eq.A.png" (acceptHdrs "application/octet-stream") ""
+        `shouldRespondWith` 406
+      request methodGet "/images?name=eq.A.png" (acceptHdrs "application/octet-stream") ""
+        `shouldRespondWith` 406
 
-    context "on RPC" $ do
-      context "Proc that returns scalar" $
-        it "can query without selecting column" $
-          request methodPost "/rpc/ret_base64_bin" (acceptHdrs "application/octet-stream") ""
-            `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCC"
-            { matchStatus = 200
-            , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"]
-            }
-
-      context "Proc that returns rows" $ do
-        it "can query if a single column is selected" $
-          request methodPost "/rpc/ret_rows_with_base64_bin?select=img" (acceptHdrs "application/octet-stream") ""
-            `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCCiVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEX///8AAP94wDzzAAAAL0lEQVQIW2NgwAb+HwARH0DEDyDxwAZEyGAhLODqHmBRzAcn5GAS///A1IF14AAA5/Adbiiz/0gAAAAASUVORK5CYII="
-            { matchStatus = 200
-            , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"]
-            }
-
-        it "fails if a single column is not selected" $
-          request methodPost "/rpc/ret_rows_with_base64_bin" (acceptHdrs "application/octet-stream") ""
-            `shouldRespondWith` 406
+    it "concatenates results if more than one row is returned" $
+      request methodGet "/images_base64?select=img&name=in.(A.png,B.png)" (acceptHdrs "application/octet-stream") ""
+        `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCCiVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEX///8AAP94wDzzAAAAL0lEQVQIW2NgwAb+HwARH0DEDyDxwAZEyGAhLODqHmBRzAcn5GAS///A1IF14AAA5/Adbiiz/0gAAAAASUVORK5CYII="
+        { matchStatus = 200
+        , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"]
+        }
 
   describe "HTTP request env vars" $ do
     it "custom header is set" $
@@ -994,7 +1045,12 @@ spec = do
         [json| [] |] { matchHeaders = [matchContentTypeJson] }
 
     it "only returns an empty result set if the in value is empty" $
-      get "/items_with_different_col_types?int_data=in.( ,3,4)" `shouldRespondWith` 400
+      get "/items_with_different_col_types?int_data=in.( ,3,4)"
+        `shouldRespondWith`
+        [json| {"hint":null,"details":null,"code":"22P02","message":"invalid input syntax for integer: \"\""} |]
+        { matchStatus = 400
+        , matchHeaders = [matchContentTypeJson]
+        }
 
   describe "Embedding when column name = table name" $ do
     it "works with child embeds" $

test/Feature/RangeSpec.hs

@@ -1,17 +1,17 @@
 module Feature.RangeSpec where
 
+import qualified Data.ByteString.Lazy as BL
+
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (simpleHeaders, simpleStatus))
+
+import Network.HTTP.Types
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
-import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
-
-import qualified Data.ByteString.Lazy         as BL
 
+import Protolude  hiding (get)
 import SpecHelper
-import Network.Wai (Application)
-
-import Protolude hiding (get)
 
 defaultRange :: BL.ByteString
 defaultRange = [json| { "min": 0, "max": 15 } |]
@@ -38,7 +38,6 @@ spec = do
             { matchHeaders = ["Content-Range" <:> "0-14/*"] }
 
     context "with range headers" $ do
-
       context "of acceptable range" $ do
         it "succeeds with partial content" $ do
           r <- request methodPost  "/rpc/getitemrange"
@@ -156,7 +155,6 @@ spec = do
           , matchHeaders = ["Content-Range" <:> "0-0/*"]
           }
 
-
       it "limit and offset works on first level" $
         get "/items?select=id&order=id.asc&limit=3&offset=2"
           `shouldRespondWith` [json|[{"id":3},{"id":4},{"id":5}]|]
@@ -164,8 +162,37 @@ spec = do
           , matchHeaders = ["Content-Range" <:> "2-4/*"]
           }
 
-    context "with range headers" $ do
+      it "succeeds if offset equals 0 as a no-op" $
+        get "/items?select=id&offset=0"
+          `shouldRespondWith`
+          [json|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-14/*"]
+          }
 
+      it "succeeds if offset is negative as a no-op" $
+        get "/items?select=id&offset=-4"
+          `shouldRespondWith`
+          [json|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
+          { matchStatus  = 200
+          , matchHeaders = ["Content-Range" <:> "0-14/*"]
+          }
+
+      it "fails if limit equals 0" $
+        get "/items?select=id&limit=0"
+          `shouldRespondWith` [json|{"message":"HTTP Range error"}|]
+          { matchStatus  = 416
+          , matchHeaders = [matchContentTypeJson]
+          }
+
+      it "fails if limit is negative" $
+        get "/items?select=id&limit=-1"
+          `shouldRespondWith` [json|{"message":"HTTP Range error"}|]
+          { matchStatus  = 416
+          , matchHeaders = [matchContentTypeJson]
+          }
+
+    context "with range headers" $ do
       context "of acceptable range" $ do
         it "succeeds with partial content" $ do
           r <- request methodGet  "/items"

test/Feature/RootSpec.hs

@@ -0,0 +1,30 @@
+module Feature.RootSpec where
+
+import Network.HTTP.Types
+import Network.Wai        (Application)
+
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import Protolude hiding (get)
+
+import SpecHelper
+
+spec :: SpecWith Application
+spec =
+  describe "root spec function" $ do
+    it "accepts application/openapi+json" $
+      request methodGet "/"
+        [("Accept","application/openapi+json")] "" `shouldRespondWith`
+        [json|{
+           "swagger": "2.0",
+           "info": {"title": "PostgREST API", "description": "This is a dynamic API generated by PostgREST"}
+          }|]
+        { matchHeaders = ["Content-Type" <:> "application/openapi+json; charset=utf-8"] }
+
+    it "accepts application/json" $
+      request methodGet "/"
+        [("Accept", "application/json")] "" `shouldRespondWith`
+        [json| [{"table": "items"}, {"table": "subitems"}] |]
+        { matchHeaders = [matchContentTypeJson] }

test/Feature/RpcSpec.hs

@@ -1,20 +1,23 @@
 module Feature.RpcSpec where
 
-import Test.Hspec
-import Test.Hspec.Wai
-import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
-import Network.Wai.Test (SResponse(simpleStatus, simpleBody))
 import qualified Data.ByteString.Lazy as BL (empty)
 
-import SpecHelper
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (simpleBody, simpleStatus))
+
+import Network.HTTP.Types
+import Test.Hspec          hiding (pendingWith)
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
 import Text.Heredoc
-import Network.Wai (Application)
 
-import Protolude hiding (get)
+import PostgREST.Types (PgVersion, pgVersion100, pgVersion95,
+                        pgVersion96)
+import Protolude       hiding (get)
+import SpecHelper
 
-spec :: SpecWith Application
-spec =
+spec :: PgVersion -> SpecWith Application
+spec actualPgVersion =
   describe "remote procedure call" $ do
     context "a proc that returns a set" $ do
       it "returns paginated results" $ do
@@ -77,6 +80,21 @@ spec =
       it "should fail with 404 on unknown proc args" $ do
         get "/rpc/sayhello" `shouldRespondWith` 404
         get "/rpc/sayhello?any_arg=value" `shouldRespondWith` 404
+      it "should not ignore unknown args and fail with 404" $
+        get "/rpc/add_them?a=1&b=2&smthelse=blabla" `shouldRespondWith`
+        let
+          message :: Text
+          message
+            | actualPgVersion < pgVersion95 = "function test.add_them(a := integer, b := integer, smthelse := text) does not exist"
+            | otherwise = "function test.add_them(a => integer, b => integer, smthelse => text) does not exist"
+        in [json| {
+          "code": "42883",
+          "details": null,
+          "hint": "No function matches the given name and argument types. You might need to add explicit type casts.",
+          "message": #{message} } |]
+        { matchStatus  = 404
+        , matchHeaders = [matchContentTypeJson]
+        }
 
     it "works when having uppercase identifiers" $ do
       get "/rpc/quotedFunction?user=mscott&fullName=Michael Scott&SSN=401-32-XXXX" `shouldRespondWith`
@@ -213,6 +231,63 @@ spec =
           [json|null|]
           { matchHeaders = [matchContentTypeJson] }
 
+    context "proc argument types" $ do
+      it "accepts a variety of arguments" $
+        post "/rpc/varied_arguments"
+            [json| {
+              "double": 3.1,
+              "varchar": "hello",
+              "boolean": true,
+              "date": "20190101",
+              "money": 0,
+              "enum": "foo",
+              "integer": 43,
+              "json": {"some key": "some value"},
+              "jsonb": {"another key": [1, 2, "3"]}
+            } |]
+          `shouldRespondWith`
+            [json|"Hi"|]
+            { matchHeaders = [matchContentTypeJson] }
+
+      it "parses embedded JSON arguments as JSON" $
+        post "/rpc/json_argument"
+            [json| { "arg": { "key": 3 } } |]
+          `shouldRespondWith`
+            [json|"object"|]
+            { matchHeaders = [matchContentTypeJson] }
+
+      when (actualPgVersion <= pgVersion96) $
+        it "parses quoted JSON arguments as JSON (Postgres <= 9.6)" $
+          post "/rpc/json_argument"
+              [json| { "arg": "{ \"key\": 3 }" } |]
+            `shouldRespondWith`
+              [json|"object"|]
+              { matchHeaders = [matchContentTypeJson] }
+
+      when (actualPgVersion >= pgVersion100) $ do
+        it "parses quoted JSON arguments as JSON string (Postgres >= 10)" $ do
+          -- Postgres bug report:
+          -- https://www.postgresql.org/message-id/D6921B37-BD8E-4664-8D5F-DB3525765DCD%40vllmrt.net
+          -- * json_to_record fails (see following test)
+          -- * jsonb_to_record parses the embedded quoted JSON to a JSON string,
+          --   so that's probably the expected behavior for Postgres >= 10
+          pendingWith "Postgres >= 10 fails to parse quoted embedded JSON"
+          post "/rpc/json_argument"
+              [json| { "arg": "{ \"key\": 3 }" } |]
+            `shouldRespondWith`
+              [json|"string"|]
+              { matchHeaders = [matchContentTypeJson] }
+
+        it "fails to parse quoted JSON arguments (Postgres >= 10)" $
+          -- Confirming buggy Postgres behavior (see previous test)
+          post "/rpc/json_argument"
+              [json| { "arg": "{ \"key\": 3 }" } |]
+            `shouldRespondWith`
+              [json|{"hint":null,"details":"Token \"key\" is invalid.","code":"22P02","message":"invalid input syntax for type json"}|]
+              { matchStatus  = 400
+              , matchHeaders = [matchContentTypeJson]
+              }
+
     context "improper input" $ do
       it "rejects unknown content type even if payload is good" $ do
         request methodPost "/rpc/sayhello"
@@ -236,7 +311,11 @@ spec =
     context "unsupported verbs" $ do
       it "DELETE fails" $
         request methodDelete "/rpc/sayhello" [] ""
-          `shouldRespondWith` 405
+          `shouldRespondWith`
+          [json|{"message":"Bad Request"}|]
+          { matchStatus  = 405
+          , matchHeaders = [matchContentTypeJson]
+          }
       it "PATCH fails" $
         request methodPatch "/rpc/sayhello" [] ""
           `shouldRespondWith` 405
@@ -302,7 +381,12 @@ spec =
         }
 
     it "defaults to status 500 if RAISE code is PT not followed by a number" $
-      get "/rpc/raise_bad_pt" `shouldRespondWith` 500
+      get "/rpc/raise_bad_pt"
+        `shouldRespondWith`
+        [json|{"hint": null, "details": null}|]
+        { matchStatus  = 500
+        , matchHeaders = [ matchContentTypeJson ]
+        }
 
     context "expects a single json object" $ do
       it "does not expand posted json into parameters" $
@@ -339,10 +423,101 @@ spec =
       get "/rpc/overloaded?a=1&b=2" `shouldRespondWith` [str|3|]
       get "/rpc/overloaded?a=1&b=2&c=3" `shouldRespondWith` [str|"123"|]
 
-    context "only for POST rpc" $
+    context "only for POST rpc" $ do
       it "gives a parse filter error if GET style proc args are specified" $
         post "/rpc/sayhello?name=John" [json|{}|] `shouldRespondWith` 400
 
+      it "ignores json keys not included in ?columns" $
+        post "/rpc/sayhello?columns=name"
+          [json|{"name": "John", "smth": "here", "other": "stuff", "fake_id": 13}|] `shouldRespondWith`
+          [json|"Hello, John"|]
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "bulk RPC" $ do
+      it "works with a scalar function an returns a json array" $
+        post "/rpc/add_them"
+          [json|[
+            {"a": 1, "b": 2},
+            {"a": 4, "b": 6},
+            {"a": 100, "b": 200}
+          ]|] `shouldRespondWith`
+          [json|
+            [3, 10, 300]
+          |] { matchHeaders = [matchContentTypeJson] }
+
+      it "works with a scalar function an returns a json array when posting CSV" $
+        request methodPost "/rpc/add_them" [("Content-Type", "text/csv")]
+          "a,b\n1,2\n4,6\n100,200"
+          `shouldRespondWith`
+          [json|
+            [3, 10, 300]
+          |]
+          { matchStatus  = 200
+          , matchHeaders = [matchContentTypeJson]
+          }
+
+      it "works with a non-scalar result" $
+        post "/rpc/get_projects_below?select=id,name"
+          [json|[
+            {"id": 1},
+            {"id": 5}
+          ]|] `shouldRespondWith`
+          [json|
+            [{"id":1,"name":"Windows 7"},
+             {"id":2,"name":"Windows 10"},
+             {"id":3,"name":"IOS"},
+             {"id":4,"name":"OSX"}]
+          |] { matchHeaders = [matchContentTypeJson] }
+
+    context "binary output" $ do
+      context "Proc that returns scalar" $ do
+        it "can query without selecting column" $
+          request methodPost "/rpc/ret_base64_bin" (acceptHdrs "application/octet-stream") ""
+            `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCC"
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"]
+            }
+
+        it "can get raw output with Accept: text/html" $
+          request methodGet "/rpc/welcome.html" (acceptHdrs "text/html") ""
+            `shouldRespondWith`
+            [str|
+                |<html>
+                |  <head>
+                |    <title>PostgREST</title>
+                |  </head>
+                |  <body>
+                |    <h1>Welcome to PostgREST</h1>
+                |  </body>
+                |</html>
+                |]
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "text/html; charset=utf-8"]
+            }
+
+        it "can get raw output with Accept: text/plain" $
+          request methodGet "/rpc/welcome" (acceptHdrs "text/plain") ""
+            `shouldRespondWith` "Welcome to PostgREST"
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]
+            }
+
+      context "Proc that returns rows" $ do
+        it "can query if a single column is selected" $
+          request methodPost "/rpc/ret_rows_with_base64_bin?select=img" (acceptHdrs "application/octet-stream") ""
+            `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCCiVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEX///8AAP94wDzzAAAAL0lEQVQIW2NgwAb+HwARH0DEDyDxwAZEyGAhLODqHmBRzAcn5GAS///A1IF14AAA5/Adbiiz/0gAAAAASUVORK5CYII="
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"]
+            }
+
+        it "fails if a single column is not selected" $
+          request methodPost "/rpc/ret_rows_with_base64_bin" (acceptHdrs "application/octet-stream") ""
+            `shouldRespondWith`
+            [json| {"message":"application/octet-stream requested but a single column was not selected"} |]
+            { matchStatus = 406
+            , matchHeaders = [matchContentTypeJson]
+            }
+
     context "only for GET rpc" $ do
       it "should fail on mutating procs" $ do
         get "/rpc/callcounter" `shouldRespondWith` 500

test/Feature/SingularSpec.hs

@@ -1,16 +1,16 @@
 module Feature.SingularSpec where
 
-import Text.Heredoc
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (..))
+
+import Network.HTTP.Types
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
-import Network.Wai.Test (SResponse(..))
-
-import Network.Wai (Application)
+import Text.Heredoc
 
+import Protolude  hiding (get)
 import SpecHelper
-import Protolude hiding (get)
 
 
 spec :: SpecWith Application
@@ -43,7 +43,6 @@ spec =
             { matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"] }
 
     context "when updating rows" $ do
-
       it "works for one row" $ do
         _ <- post "/addresses" [json| { id: 97, address: "A Street" } |]
         request methodPatch
@@ -56,10 +55,9 @@ spec =
       it "raises an error for multiple rows" $ do
         _ <- post "/addresses" [json| { id: 98, address: "xxx" } |]
         _ <- post "/addresses" [json| { id: 99, address: "yyy" } |]
-        p <- request methodPatch
-          "/addresses?id=gt.0"
-          [("Prefer", "return=representation"), singular]
-          [json| { address: "zzz" } |]
+        p <- request methodPatch "/addresses?id=gt.0"
+                [("Prefer", "return=representation"), singular]
+                [json| { address: "zzz" } |]
         liftIO $ do
           simpleStatus p `shouldBe` notAcceptable406
           isErrorFormat (simpleBody p) `shouldBe` True
@@ -67,15 +65,16 @@ spec =
         -- the rows should not be updated, either
         get "/addresses?id=eq.98" `shouldRespondWith` [str|[{"id":98,"address":"xxx"}]|]
 
-      it "raises an error for zero rows" $ do
-        p <- request methodPatch  "/items?id=gt.0&id=lt.0"
-          [("Prefer", "return=representation"), singular] [json|{"id":1}|]
-        liftIO $ do
-          simpleStatus p `shouldBe` notAcceptable406
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "raises an error for zero rows" $
+        request methodPatch "/items?id=gt.0&id=lt.0"
+                [("Prefer", "return=representation"), singular] [json|{"id":1}|]
+          `shouldRespondWith`
+                  [str|{"details":"Results contain 0 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                  { matchStatus  = 406
+                  , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                  }
 
     context "when creating rows" $ do
-
       it "works for one row" $ do
         p <- request methodPost
           "/addresses"
@@ -117,17 +116,17 @@ spec =
           , matchHeaders = ["Content-Range" <:> "*/*"]
           }
 
-      it "raises an error when creating zero entities" $ do
-        p <- request methodPost
-          "/addresses"
-          [("Prefer", "return=representation"), singular]
-          [json| [ ] |]
-        liftIO $ do
-          simpleStatus p `shouldBe` notAcceptable406
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "raises an error when creating zero entities" $
+        request methodPost "/addresses"
+                [("Prefer", "return=representation"), singular]
+                [json| [ ] |]
+          `shouldRespondWith`
+                  [str|{"details":"Results contain 0 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                  { matchStatus  = 406
+                  , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                  }
 
     context "when deleting rows" $ do
-
       it "works for one row" $ do
         p <- request methodDelete
           "/items?id=eq.11"
@@ -146,21 +145,24 @@ spec =
           , matchHeaders = ["Content-Range" <:> "0-9/*"]
           }
 
-      it "raises an error when deleting zero entities" $ do
-        p <- request methodDelete "/items?id=lt.0"
-          [("Prefer", "return=representation"), singular] ""
-        liftIO $ do
-          simpleStatus p `shouldBe` notAcceptable406
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "raises an error when deleting zero entities" $
+        request methodDelete "/items?id=lt.0"
+                [("Prefer", "return=representation"), singular] ""
+          `shouldRespondWith`
+                [str|{"details":"Results contain 0 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                { matchStatus  = 406
+                , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                }
 
     context "when calling a stored proc" $ do
-
-      it "fails for zero rows" $ do
-        p <- request methodPost "/rpc/getproject"
-          [singular] [json|{ "id": 9999999}|]
-        liftIO $ do
-          simpleStatus p `shouldBe` notAcceptable406
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "fails for zero rows" $
+        request methodPost "/rpc/getproject"
+                [singular] [json|{ "id": 9999999}|]
+          `shouldRespondWith`
+                [str|{"details":"Results contain 0 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                { matchStatus  = 406
+                , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                }
 
       -- this one may be controversial, should vnd.pgrst.object include
       -- the likes of 2 and "hello?"
@@ -174,20 +176,26 @@ spec =
           [singular] [json|{ "id": 1}|] `shouldRespondWith`
           [str|{"id":1,"name":"Windows 7","client_id":1}|]
 
-      it "fails for multiple rows" $ do
-        p <- request methodPost "/rpc/getallprojects" [singular] "{}"
-        liftIO $ do
-          simpleStatus p `shouldBe` notAcceptable406
-          isErrorFormat (simpleBody p) `shouldBe` True
+      it "fails for multiple rows" $
+        request methodPost "/rpc/getallprojects"
+                [singular] "{}"
+          `shouldRespondWith`
+                [str|{"details":"Results contain 5 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                { matchStatus  = 406
+                , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                }
 
       it "executes the proc exactly once per request" $ do
         request methodPost "/rpc/getproject?select=id,name" [] [json| {"id": 1} |]
           `shouldRespondWith` [str|[{"id":1,"name":"Windows 7"}]|]
-        p <- request methodPost "/rpc/setprojects" [singular]
-          [json| {"id_l": 1, "id_h": 2, "name": "changed"} |]
-        liftIO $ do
-          simpleStatus p `shouldBe` notAcceptable406
-          isErrorFormat (simpleBody p) `shouldBe` True
+
+        request methodPost "/rpc/setprojects" [singular]
+                [json| {"id_l": 1, "id_h": 2, "name": "changed"} |]
+          `shouldRespondWith`
+                [str|{"details":"Results contain 2 rows, application/vnd.pgrst.object+json requires 1 row","message":"JSON object requested, multiple (or no) rows returned"}|]
+                { matchStatus  = 406
+                , matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"]
+                }
 
         -- should not actually have executed the function
         request methodPost "/rpc/getproject?select=id,name" [] [json| {"id": 1} |]

test/Feature/StructureSpec.hs

@@ -1,22 +1,22 @@
 module Feature.StructureSpec where
 
-import Test.Hspec
-import Test.Hspec.Wai
-import Network.HTTP.Types
-
-import PostgREST.Config (docsVersion)
-import Control.Lens ((^?))
+import Control.Lens     ((^?))
 import Data.Aeson.Types (Value (..))
+import Network.Wai      (Application)
+import Network.Wai.Test (SResponse (..))
+
 import Data.Aeson.Lens
 import Data.Aeson.QQ
+import Network.HTTP.Types
+import Test.Hspec         hiding (pendingWith)
+import Test.Hspec.Wai
 
+
+
+import PostgREST.Config (docsVersion)
+import Protolude        hiding (get)
 import SpecHelper
 
-import Network.Wai (Application)
-import Network.Wai.Test (SResponse(..))
-
-import Protolude hiding (get)
-
 spec :: SpecWith Application
 spec = do
 
@@ -219,6 +219,158 @@ spec = do
               ]
             |]
 
+    describe "PostgreSQL to Swagger Type Mapping" $ do
+
+      it "character varying to string" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_character_varying"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "character varying",
+                "type": "string"
+              }
+            |]
+      it "character(1) to string" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_character"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "maxLength": 1,
+                "format": "character",
+                "type": "string"
+              }
+            |]
+
+      it "text to string" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_text"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "text",
+                "type": "string"
+              }
+            |]
+
+      it "boolean to boolean" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_boolean"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "boolean",
+                "type": "boolean"
+              }
+            |]
+
+      it "smallint to integer" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_smallint"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "smallint",
+                "type": "integer"
+              }
+            |]
+
+      it "integer to integer" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_integer"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "integer",
+                "type": "integer"
+              }
+            |]
+
+      it "bigint to integer" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_bigint"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "bigint",
+                "type": "integer"
+              }
+            |]
+
+      it "numeric to number" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_numeric"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "numeric",
+                "type": "number"
+              }
+            |]
+
+      it "real to number" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_real"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "real",
+                "type": "number"
+              }
+            |]
+
+      it "double_precision to number" $ do
+        r <- simpleBody <$> get "/"
+
+        let types = r ^? key "definitions" . key "openapi_types" . key "properties" . key "a_double_precision"
+
+        liftIO $
+
+          types `shouldBe` Just
+            [aesonQQ|
+              {
+                "format": "double precision",
+                "type": "number"
+              }
+            |]
+
     describe "RPC" $ do
 
       it "includes function summary/description and body schema for arguments" $ do
@@ -249,7 +401,7 @@ spec = do
                 "properties": {
                   "double": {
                     "format": "double precision",
-                    "type": "string"
+                    "type": "number"
                   },
                   "varchar": {
                     "format": "character varying",
@@ -274,6 +426,14 @@ spec = do
                   "integer": {
                     "format": "integer",
                     "type": "integer"
+                  },
+                  "json": {
+                    "format": "json",
+                    "type": "string"
+                  },
+                  "jsonb": {
+                    "format": "jsonb",
+                    "type": "string"
                   }
                 },
                 "type": "object",

test/Feature/UnicodeSpec.hs

@@ -1,15 +1,15 @@
 module Feature.UnicodeSpec where
 
+import Control.Monad (void)
+import Network.Wai   (Application)
+
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.Wai (Application)
-import Control.Monad (void)
 
+import Protolude  hiding (get)
 import SpecHelper
 
-import Protolude hiding (get)
-
 spec :: SpecWith Application
 spec =
   describe "Reading and writing to unicode schema and table names" $

test/Feature/UpsertSpec.hs

@@ -1,16 +1,16 @@
 module Feature.UpsertSpec where
 
+import Network.Wai (Application)
+
+import Network.HTTP.Types
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Network.HTTP.Types
-
-import SpecHelper
-import Network.Wai (Application)
-
-import Protolude hiding (get, put)
 import Text.Heredoc
 
+import Protolude  hiding (get, put)
+import SpecHelper
+
 spec :: SpecWith Application
 spec =
   describe "UPSERT" $ do
@@ -44,6 +44,12 @@ spec =
             , matchHeaders = ["Preference-Applied" <:> "resolution=merge-duplicates", matchContentTypeJson]
             }
 
+        it "succeeds when the payload has no elements" $
+          request methodPost "/articles" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")]
+            [json|[]|] `shouldRespondWith`
+            [json|[]|] { matchStatus = 201 , matchHeaders = [matchContentTypeJson] }
+
+
       context "when Prefer: resolution=ignore-duplicates is specified" $ do
         it "INSERTs and ignores rows on pk conflict" $
           request methodPost "/tiobe_pls" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")]
@@ -104,48 +110,96 @@ spec =
       context "Restrictions" $ do
         it "fails if Range is specified" $
           request methodPut "/tiobe_pls?name=eq.Javascript" [("Range", "0-5")]
-            [str| [ { "name": "Javascript", "rank": 1 } ]|] `shouldRespondWith` 400
+            [str| [ { "name": "Javascript", "rank": 1 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Range header and limit/offset querystring parameters are not allowed for PUT"}|]
+            { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
 
         it "fails if limit is specified" $
           put "/tiobe_pls?name=eq.Javascript&limit=1"
-            [str| [ { "name": "Javascript", "rank": 1 } ]|] `shouldRespondWith` 400
+            [str| [ { "name": "Javascript", "rank": 1 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Range header and limit/offset querystring parameters are not allowed for PUT"}|]
+            { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
 
         it "fails if offset is specified" $
           put "/tiobe_pls?name=eq.Javascript&offset=1"
-            [str| [ { "name": "Javascript", "rank": 1 } ]|] `shouldRespondWith` 400
+            [str| [ { "name": "Javascript", "rank": 1 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Range header and limit/offset querystring parameters are not allowed for PUT"}|]
+            { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
 
         it "fails if the payload has more than one row" $
           put "/tiobe_pls?name=eq.Go"
-            [str| [ { "name": "Go", "rank": 19 }, { "name": "Swift", "rank": 12 } ]|] `shouldRespondWith` 400
+            [str| [ { "name": "Go", "rank": 19 }, { "name": "Swift", "rank": 12 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"PUT payload must contain a single row"}|]
+            { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
 
         it "fails if not all columns are specified" $ do
           put "/tiobe_pls?name=eq.Go"
-            [str| [ { "name": "Go" } ]|] `shouldRespondWith` 400
+            [str| [ { "name": "Go" } ]|]
+            `shouldRespondWith`
+            [json|{"message":"You must specify all columns in the payload when using PUT"}|]
+            { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
+
           put "/employees?first_name=eq.Susan&last_name=eq.Heidt"
-            [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000" } ]|] `shouldRespondWith` 400
+            [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000" } ]|]
+            `shouldRespondWith`
+            [json|{"message":"You must specify all columns in the payload when using PUT"}|]
+            { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
 
         it "rejects every other filter than pk cols eq's" $ do
-          put "/tiobe_pls?rank=eq.19" [str| [ { "name": "Go", "rank": 19 } ]|] `shouldRespondWith` 405
-          put "/tiobe_pls?id=not.eq.Java" [str| [ { "name": "Go", "rank": 19 } ]|] `shouldRespondWith` 405
-          put "/tiobe_pls?id=in.(Go)" [str| [ { "name": "Go", "rank": 19 } ]|] `shouldRespondWith` 405
-          put "/tiobe_pls?and=(id.eq.Go)" [str| [ { "name": "Go", "rank": 19 } ]|] `shouldRespondWith` 405
+          put "/tiobe_pls?rank=eq.19"
+            [str| [ { "name": "Go", "rank": 19 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+            { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
+
+          put "/tiobe_pls?id=not.eq.Java"
+            [str| [ { "name": "Go", "rank": 19 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+            { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
+          put "/tiobe_pls?id=in.(Go)"
+            [str| [ { "name": "Go", "rank": 19 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+            { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
+          put "/tiobe_pls?and=(id.eq.Go)"
+            [str| [ { "name": "Go", "rank": 19 } ]|]
+            `shouldRespondWith`
+            [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+            { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
 
         it "fails if not all composite key cols are specified as eq filters" $ do
           put "/employees?first_name=eq.Susan"
             [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000", "company": "GEX", "occupation": "Railroad engineer" } ]|]
-            `shouldRespondWith` 405
+            `shouldRespondWith`
+            [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+            { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
           put "/employees?last_name=eq.Heidt"
             [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000", "company": "GEX", "occupation": "Railroad engineer" } ]|]
-            `shouldRespondWith` 405
+            `shouldRespondWith`
+            [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+            { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
 
       it "fails if the uri primary key doesn't match the payload primary key" $ do
-        put "/tiobe_pls?name=eq.MATLAB"
-          [str| [ { "name": "Perl", "rank": 17 } ]|] `shouldRespondWith` 400
+        put "/tiobe_pls?name=eq.MATLAB" [str| [ { "name": "Perl", "rank": 17 } ]|]
+          `shouldRespondWith`
+          [json|{"message":"Payload values do not match URL in primary key column(s)"}|]
+          { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
         put "/employees?first_name=eq.Wendy&last_name=eq.Anderson"
-          [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000", "company": "GEX", "occupation": "Railroad engineer" } ]|] `shouldRespondWith` 400
+          [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000", "company": "GEX", "occupation": "Railroad engineer" } ]|]
+          `shouldRespondWith`
+          [json|{"message":"Payload values do not match URL in primary key column(s)"}|]
+          { matchStatus = 400 , matchHeaders = [matchContentTypeJson] }
 
       it "fails if the table has no PK" $
-        put "/no_pk?a=eq.one&b=eq.two" [str| [ { "a": "one", "b": "two" } ]|] `shouldRespondWith` 405
+        put "/no_pk?a=eq.one&b=eq.two" [str| [ { "a": "one", "b": "two" } ]|]
+          `shouldRespondWith`
+          [json|{"message":"Filters must include all and only primary key columns with 'eq' operators"}|]
+          { matchStatus = 405 , matchHeaders = [matchContentTypeJson] }
 
       context "Inserting row" $ do
         it "succeeds on table with single pk col" $ do

test/Main.hs

@@ -1,23 +1,28 @@
 module Main where
 
-import Test.Hspec
-import SpecHelper
-
-import qualified Hasql.Pool as P
+import qualified Hasql.Pool                 as P
 import qualified Hasql.Transaction.Sessions as HT
 
-import PostgREST.App (postgrest)
-import PostgREST.DbStructure (getDbStructure, getPgVersion)
-import PostgREST.Types (DbStructure(..), pgVersion95, pgVersion96)
-import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction)
-import Data.Function (id)
-import Data.IORef
-import Data.Time.Clock (getCurrentTime)
+import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
+                           updateAction)
+import Data.Function      (id)
+import Data.Time.Clock    (getCurrentTime)
 
-import qualified Feature.AuthSpec
+import Data.IORef
+import Test.Hspec
+
+import PostgREST.App         (postgrest)
+import PostgREST.DbStructure (getDbStructure, getPgVersion)
+import PostgREST.Types       (DbStructure (..), pgVersion95,
+                              pgVersion96)
+import Protolude
+import SpecHelper
+
+import qualified Feature.AndOrParamsSpec
 import qualified Feature.AsymmetricJwtSpec
-import qualified Feature.BinaryJwtSecretSpec
 import qualified Feature.AudienceJwtSecretSpec
+import qualified Feature.AuthSpec
+import qualified Feature.BinaryJwtSecretSpec
 import qualified Feature.ConcurrentSpec
 import qualified Feature.CorsSpec
 import qualified Feature.DeleteSpec
@@ -25,21 +30,20 @@ import qualified Feature.ExtraSearchPathSpec
 import qualified Feature.InsertSpec
 import qualified Feature.JsonOperatorSpec
 import qualified Feature.NoJwtSpec
-import qualified Feature.QueryLimitedSpec
-import qualified Feature.QuerySpec
-import qualified Feature.RangeSpec
-import qualified Feature.StructureSpec
-import qualified Feature.SingularSpec
-import qualified Feature.UnicodeSpec
-import qualified Feature.ProxySpec
-import qualified Feature.AndOrParamsSpec
-import qualified Feature.RpcSpec
 import qualified Feature.NonexistentSchemaSpec
 import qualified Feature.PgVersion95Spec
 import qualified Feature.PgVersion96Spec
+import qualified Feature.ProxySpec
+import qualified Feature.QueryLimitedSpec
+import qualified Feature.QuerySpec
+import qualified Feature.RangeSpec
+import qualified Feature.RootSpec
+import qualified Feature.RpcSpec
+import qualified Feature.SingularSpec
+import qualified Feature.StructureSpec
+import qualified Feature.UnicodeSpec
 import qualified Feature.UpsertSpec
 
-import Protolude
 
 main :: IO ()
 main = do
@@ -52,7 +56,7 @@ main = do
     ver <- getPgVersion
     HT.transaction HT.ReadCommitted HT.Read $ getDbStructure "test" ver
 
-  dbStructure <- pure $ either (panic.show) id result
+  let dbStructure = either (panic.show) id result
 
   getTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime }
 
@@ -69,6 +73,7 @@ main = do
       asymJwkSetApp        = return $ postgrest (testCfgAsymJWKSet testDbConn)        refDbStructure pool getTime $ pure ()
       nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn) refDbStructure pool getTime $ pure ()
       extraSearchPathApp   = return $ postgrest (testCfgExtraSearchPath testDbConn)   refDbStructure pool getTime $ pure ()
+      rootSpecApp          = return $ postgrest (testCfgRootSpec testDbConn)          refDbStructure pool getTime $ pure ()
 
   let reset :: IO ()
       reset = resetDb testDbConn
@@ -80,14 +85,14 @@ main = do
         [("Feature.PgVersion96Spec", Feature.PgVersion96Spec.spec) | actualPgVersion >= pgVersion96]
 
       specs = uncurry describe <$> [
-          ("Feature.AuthSpec"               , Feature.AuthSpec.spec)
+          ("Feature.AuthSpec"               , Feature.AuthSpec.spec actualPgVersion)
         , ("Feature.ConcurrentSpec"         , Feature.ConcurrentSpec.spec)
         , ("Feature.CorsSpec"               , Feature.CorsSpec.spec)
         , ("Feature.DeleteSpec"             , Feature.DeleteSpec.spec)
-        , ("Feature.InsertSpec"             , Feature.InsertSpec.spec)
-        , ("Feature.JsonOperatorSpec"       , Feature.JsonOperatorSpec.spec)
+        , ("Feature.InsertSpec"             , Feature.InsertSpec.spec actualPgVersion)
+        , ("Feature.JsonOperatorSpec"       , Feature.JsonOperatorSpec.spec actualPgVersion)
         , ("Feature.QuerySpec"              , Feature.QuerySpec.spec)
-        , ("Feature.RpcSpec"                , Feature.RpcSpec.spec)
+        , ("Feature.RpcSpec"                , Feature.RpcSpec.spec actualPgVersion)
         , ("Feature.RangeSpec"              , Feature.RangeSpec.spec)
         , ("Feature.SingularSpec"           , Feature.SingularSpec.spec)
         , ("Feature.StructureSpec"          , Feature.StructureSpec.spec)
@@ -136,3 +141,8 @@ main = do
     -- this test runs with an extra search path
     beforeAll_ reset . before extraSearchPathApp $
       describe "Feature.ExtraSearchPathSpec" Feature.ExtraSearchPathSpec.spec
+
+    -- this test runs with a root spec function override
+    when (actualPgVersion >= pgVersion96) $
+      beforeAll_ reset . before rootSpecApp $
+        describe "Feature.RootSpec" Feature.RootSpec.spec

test/SpecHelper.hs

@@ -1,34 +1,29 @@
 module SpecHelper where
 
-import Control.Monad (void)
+import qualified Data.ByteString.Base64 as B64 (decodeLenient, encode)
+import qualified Data.ByteString.Char8  as BS
+import qualified Data.ByteString.Lazy   as BL
+import qualified Data.Map.Strict        as M
+import qualified Data.Set               as S
+import qualified System.IO.Error        as E
 
-import qualified System.IO.Error as E
-import System.Environment (getEnv)
+import Control.Monad        (void)
+import Data.Aeson           (Value (..), decode, encode)
+import Data.CaseInsensitive (CI (..))
+import Data.List            (lookup)
+import Network.Wai.Test     (SResponse (simpleBody, simpleHeaders, simpleStatus))
+import System.Environment   (getEnv)
+import System.Process       (readProcess)
+import Text.Regex.TDFA      ((=~))
 
-import qualified Data.ByteString.Base64 as B64 (encode, decodeLenient)
-import Data.CaseInsensitive (CI(..))
-import qualified Data.Set as S
-import qualified Data.Map.Strict as M
-import Data.List (lookup)
-import Text.Regex.TDFA ((=~))
-import qualified Data.ByteString.Char8 as BS
-import qualified Data.ByteString.Lazy as BL
-import           System.Process (readProcess)
-import           Text.Heredoc
-
-import PostgREST.Config (AppConfig(..))
-import PostgREST.Types  (JSPathExp(..))
-
-import Test.Hspec
-import Test.Hspec.Wai
 
 import Network.HTTP.Types
-import Network.Wai.Test (SResponse(simpleStatus, simpleHeaders, simpleBody))
-
-import Data.Maybe (fromJust)
-import Data.Aeson (decode, Value(..))
-import qualified JSONSchema.Draft4 as D4
+import Test.Hspec
+import Test.Hspec.Wai
+import Text.Heredoc
 
+import PostgREST.Config (AppConfig (..))
+import PostgREST.Types  (JSPathExp (..), QualifiedIdentifier (..))
 import Protolude
 
 matchContentTypeJson :: MatchHeader
@@ -48,17 +43,19 @@ validateOpenApiResponse headers = do
     let respHeaders = simpleHeaders r in
     respHeaders `shouldSatisfy`
       \hs -> ("Content-Type", "application/openapi+json; charset=utf-8") `elem` hs
-  liftIO $
-    let respBody = simpleBody r
-        schema :: D4.Schema
-        schema = D4.emptySchema { D4._schemaRef = Just "openapi.json" }
-        schemaContext :: D4.SchemaWithURI D4.Schema
-        schemaContext = D4.SchemaWithURI
-          { D4._swSchema = schema
-          , D4._swURI    = Just "test/fixtures/openapi.json"
-          }
-       in
-       D4.fetchFilesystemAndValidate schemaContext ((fromJust . decode) respBody) `shouldReturn` Right ()
+  let Just body = decode (simpleBody r)
+  Just schema <- liftIO $ decode <$> BL.readFile "test/fixtures/openapi.json"
+  let args :: M.Map Text Value
+      args = M.fromList
+        [ ( "schema", schema )
+        , ( "data", body ) ]
+      hdrs = acceptHdrs "application/json"
+  request methodPost "/rpc/validate_json_schema" hdrs (encode args)
+      `shouldRespondWith` "true"
+      { matchStatus = 200
+      , matchHeaders = []
+      }
+
 
 getEnvVarWithDefault :: Text -> Text -> IO Text
 getEnvVarWithDefault var def = toS <$>
@@ -67,10 +64,12 @@ getEnvVarWithDefault var def = toS <$>
 _baseCfg :: AppConfig
 _baseCfg =  -- Connection Settings
   AppConfig mempty "postgrest_test_anonymous" Nothing "test" "localhost" 3000
+            -- No user configured Unix Socket
+            Nothing
             -- Jwt settings
             (Just $ encodeUtf8 "reallyreallyreallyreallyverysafe") False Nothing
             -- Connection Modifiers
-            10 Nothing (Just "test.switch_role")
+            10 10 Nothing (Just "test.switch_role")
             -- Debug Settings
             True
             [ ("app.settings.app_host", "localhost")
@@ -80,6 +79,8 @@ _baseCfg =  -- Connection Settings
             (Right [JSPKey "role"])
             -- Empty db-extra-search-path
             []
+            -- No root spec override
+            Nothing
 
 testCfg :: Text -> AppConfig
 testCfg testDbConn = _baseCfg { configDatabase = testDbConn }
@@ -127,12 +128,16 @@ testNonexistentSchemaCfg testDbConn = (testCfg testDbConn) { configSchema = "non
 testCfgExtraSearchPath :: Text -> AppConfig
 testCfgExtraSearchPath testDbConn = (testCfg testDbConn) { configExtraSearchPath = ["public", "extensions"] }
 
+testCfgRootSpec :: Text -> AppConfig
+testCfgRootSpec testDbConn = (testCfg testDbConn) { configRootSpec = Just $ QualifiedIdentifier "test" "root"}
+
 setupDb :: Text -> IO ()
 setupDb dbConn = do
   loadFixture dbConn "database"
   loadFixture dbConn "roles"
   loadFixture dbConn "schema"
   loadFixture dbConn "jwt"
+  loadFixture dbConn "jsonschema"
   loadFixture dbConn "privileges"
   resetDb dbConn
 
@@ -141,7 +146,7 @@ resetDb dbConn = loadFixture dbConn "data"
 
 loadFixture :: Text -> FilePath -> IO()
 loadFixture dbConn name =
-  void $ readProcess "psql" [toS dbConn, "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] []
+  void $ readProcess "psql" ["--set", "ON_ERROR_STOP=1", toS dbConn, "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] []
 
 rangeHdrs :: ByteRange -> [Header]
 rangeHdrs r = [rangeUnit, (hRange, renderByteRange r)]

test/TestTypes.hs

@@ -3,16 +3,16 @@ module TestTypes (
 , CompoundPK(..)
 ) where
 
+import           Data.Aeson ((.:))
 import qualified Data.Aeson as JSON
-import Data.Aeson ((.:))
 
 import Protolude
 
 data IncPK = IncPK {
-  incId :: Int
+  incId          :: Int
 , incNullableStr :: Maybe Text
-, incStr :: Text
-, incInsert :: Text
+, incStr         :: Text
+, incInsert      :: Text
 } deriving (Eq, Show)
 
 instance JSON.FromJSON IncPK where
@@ -24,8 +24,8 @@ instance JSON.FromJSON IncPK where
   parseJSON _ = mzero
 
 data CompoundPK = CompoundPK {
-  compoundK1 :: Int
-, compoundK2 :: Text
+  compoundK1    :: Int
+, compoundK2    :: Text
 , compoundExtra :: Maybe Int
 } deriving (Eq, Show)
 

test/Unit/DbStructureSpec.hx

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

test/Unit/PgQuerySpec.hx

@@ -1,99 +0,0 @@
-module Unit.PgQuerySpec where
-
-import Test.Hspec
-import Test.QuickCheck
-import Test.QuickCheck.Monadic
-
-import Database.HDBC (IConnection, SqlValue, toSql, prepare,
-  quickQuery, fromSql, execute, seState, fetchAllRowsAL)
-
-import PgQuery (LoginAttempt(..), insert, addUser, signInRole, checkPass
-              , pgFmtIdent, pgFmtLit)
-import Types (SqlRow(SqlRow))
-import TestTypes (incFromList, incStr, incNullableStr, incInsert, incId)
-import Data.Map (toList)
-import Data.String.Conversions (cs)
-import Data.Monoid ((<>))
-import Control.Arrow
-
-import SpecHelper(dbWithSchema)
-
-quickALQuery :: IConnection conn => conn ->
-                String ->
-                [SqlValue] ->
-                IO [[(String, SqlValue)]]
-quickALQuery conn q bind = do
-  sth <- prepare conn q
-  _ <- execute sth bind
-  fetchAllRowsAL sth
-
-spec :: Spec
-spec = around dbWithSchema $ do
-  describe "insert" $
-    describe "with an auto-increment key" $ do
-      it "inserts and responds with a full object description" $ \conn -> do
-        r <- insert "test" "auto_incrementing_pk" (SqlRow [
-            ("non_nullable_string", toSql ("a string"::String))]) conn
-        let returnRow = incFromList . toList $ r
-        incStr returnRow `shouldBe` "a string"
-        incNullableStr returnRow `shouldBe` Nothing
-        incInsert returnRow `shouldSatisfy` not . null
-        incId returnRow `shouldSatisfy` (>= 0)
-        tRows <- quickALQuery conn "select * from \"1\".auto_incrementing_pk" []
-        [returnRow] `shouldBe` map incFromList tRows
-
-      it "throws an exception if the PK is not unique" $ \conn -> do
-        r <- insert "test" "auto_incrementing_pk" (SqlRow [
-            ("non_nullable_string", toSql ("a string"::String))]) conn
-        let row = SqlRow .  map (Control.Arrow.first cs) . toList $ r
-        insert "test" "auto_incrementing_pk" row conn `shouldThrow` \e ->
-          seState e == "23505" -- uniqueness violation code
-
-      it "throws an exception if a required value is missing" $ \conn ->
-        insert "test" "auto_incrementing_pk" (SqlRow [
-          ("nullable_string", toSql ("a string"::String))]) conn
-          `shouldThrow` \e -> seState e == "23502"
-
-      it "generates a default values query if no data is provided" $ \c -> do
-        r <- insert "test" "items" (SqlRow []) c
-        let [row] = toList r
-        quickALQuery c "select * from \"1\".items where id = ?" [snd row]
-          `shouldReturn` [[row]]
-
-  let {user = "jdoe"; pass = "secret"; role = "postgrest_test_default_role"}
-  describe "addUser" $ do
-    it "adds a correct user to the right table" $ \conn -> do
-      addUser user pass role conn
-      [r] <- quickQuery conn "select * from postgrest.auth" []
-      let [newUser, newRole, encryptedPass] = map fromSql r :: [String]
-      cs newUser `shouldBe` user
-      cs newRole `shouldBe` role
-      checkPass (cs encryptedPass) pass `shouldBe` True
-
-    it "will not add a user with an unknown role" $ \conn ->
-      addUser user pass "not-a-real-role" conn `shouldThrow` \e ->
-        take 2 (seState e) == "23" --integrity constraint violation
-
-
-  describe "signInRole" $ beforeWith (\conn -> do
-    addUser user pass role conn
-    return conn) $ do
-    it "accepts correct credentials and return the role" $ \conn ->
-      signInRole user pass conn `shouldReturn` LoginSuccess role user
-
-    it "returns nothing with bad creds" $ \conn -> do
-      signInRole "not-a-user" pass conn `shouldReturn` LoginFailed
-      signInRole user (pass <> "crap") conn `shouldReturn` LoginFailed
-
-  describe "pgFmtIdent" $
-    it "Does what format %I would do" $ \conn -> property $ \fuzz ->
-      monadicIO $ do
-        [[row]] <- run $ quickALQuery conn "select format('%I', ? :: varchar)" [toSql (fuzz :: String)]
-        assert $ fromSql (snd row) == pgFmtIdent (cs fuzz)
-
-  describe "pgFmtLit" $
-    it "Does what format %L would do" $ \conn ->
-      property $ monadicIO $ do
-        fuzz <- pick arbitrary
-        [[row]] <- run $ quickALQuery conn "select format('%L', ? :: varchar)" [toSql (fuzz :: String)]
-        assert $ fromSql (snd row) == pgFmtLit (cs fuzz)

test/create_test_db

@@ -1,19 +1,23 @@
 #! /usr/bin/env bash
-if [ -z "$1" ]
-  then
-    echo "Please supply the connection uri for the user with create database privileges"
-    exit -1
+
+usage() {
+  echo "$0 <db-uri> <test-database>"
+  exit -1
+}
+
+if [ -z "$1" ]; then
+  echo "Please supply the connection uri for the user with create database privileges"
+  usage
 fi
 
-if [ -z "$2" ]
-  then
-    echo "Please supply the test database name"
-    exit -1
+if [ -z "$2" ]; then
+  echo "Please supply the test database name"
+  usage
 fi
-if [[ $1 != postgres://* ]]
-then
+
+if [[ $1 != postgres://* ]]; then
   echo "Please use a valid connection URI (https://www.postgresql.org/docs/current/static/libpq-connect.html#AEN45347)"
-  exit -1
+  usage
 fi
 
 BASEPATH=$( cd $(dirname $0) ; pwd -P )
@@ -43,9 +47,14 @@ WHERE pg_stat_activity.datname = '$DB'
 DROP DATABASE IF EXISTS $DB;
 DROP ROLE IF EXISTS $TEST_USER_NAME;
 CREATE USER $TEST_USER_NAME WITH SUPERUSER LOGIN NOINHERIT PASSWORD '$TEST_USER_PASS' CREATEROLE;
-CREATE DATABASE $DB OWNER $TEST_USER_NAME;
+ALTER ROLE postgrest_test_authenticator SET default_text_search_config TO english;
+CREATE DATABASE $DB OWNER $TEST_USER_NAME LC_COLLATE 'POSIX' LC_CTYPE 'POSIX' TEMPLATE template0;
 \\connect $DB
 ALTER SCHEMA public OWNER TO $TEST_USER_NAME;
+ALTER DATABASE $DB SET LC_MESSAGES = 'POSIX';
+ALTER DATABASE $DB SET LC_MONETARY = 'POSIX';
+ALTER DATABASE $DB SET LC_NUMERIC = 'POSIX';
+ALTER DATABASE $DB SET LC_TIME = 'POSIX';
 EOF
 
 #Remove database path from the connection uri--prevents setting up the new database name with PGDATABASE

test/fixtures/data.sql

@@ -354,11 +354,21 @@ INSERT INTO family_tree VALUES ('3', 'Kid Two', '1');
 INSERT INTO family_tree VALUES ('4', 'Grandkid One', '2');
 INSERT INTO family_tree VALUES ('5', 'Grandkid Two', '3');
 
+TRUNCATE TABLE managers CASCADE;
+INSERT INTO managers VALUES (1, 'Referee Manager');
+INSERT INTO managers VALUES (2, 'Auditor Manager');
+INSERT INTO managers VALUES (3, 'Acme Manager');
+INSERT INTO managers VALUES (4, 'Umbrella Manager');
+INSERT INTO managers VALUES (5, 'Cyberdyne Manager');
+INSERT INTO managers VALUES (6, 'Oscorp Manager');
+
 TRUNCATE TABLE organizations CASCADE;
-INSERT INTO organizations VALUES (1, 'Referee Org', null, null);
-INSERT INTO organizations VALUES (2, 'Auditor Org', null, null);
-INSERT INTO organizations VALUES (3, 'Acme', 1, 2);
-INSERT INTO organizations VALUES (4, 'Umbrella', 1, 2);
+INSERT INTO organizations VALUES (1, 'Referee Org', null, null, 1);
+INSERT INTO organizations VALUES (2, 'Auditor Org', null, null, 2);
+INSERT INTO organizations VALUES (3, 'Acme', 1, 2, 3);
+INSERT INTO organizations VALUES (4, 'Umbrella', 1, 2, 4);
+INSERT INTO organizations VALUES (5, 'Cyberdyne', 3, 4, 5);
+INSERT INTO organizations VALUES (6, 'Oscorp', 3, 4, 6);
 
 SET search_path = private, pg_catalog;
 

test/fixtures/jsonschema.sql

@@ -0,0 +1,280 @@
+-- from gavinwahl/postgres-json-schema commit 5a257e19a1569a77b82e9182b0b7d9fc8b6f6382
+
+/*
+Copyright (c) 2016, Gavin Wahl
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose, without fee, and without a written agreement is
+hereby granted, provided that the above copyright notice and this paragraph and
+the following two paragraphs appear in all copies.
+
+IN NO EVENT SHALL GAVIN WAHL BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT,
+SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, INCLUDING LOST PROFITS, ARISING
+OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF GAVIN WAHL HAS
+BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+GAVIN WAHL SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT LIMITED
+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND GAVIN WAHL
+HAS NO OBLIGATIONS TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+*/
+
+CREATE OR REPLACE FUNCTION _validate_json_schema_type(type text, data jsonb) RETURNS boolean AS $f$
+BEGIN
+  IF type = 'integer' THEN
+    IF jsonb_typeof(data) != 'number' THEN
+      RETURN false;
+    END IF;
+    IF trunc(data::text::numeric) != data::text::numeric THEN
+      RETURN false;
+    END IF;
+  ELSE
+    IF type != jsonb_typeof(data) THEN
+      RETURN false;
+    END IF;
+  END IF;
+  RETURN true;
+END;
+$f$ LANGUAGE 'plpgsql' IMMUTABLE;
+
+CREATE OR REPLACE FUNCTION test.validate_json_schema(schema jsonb, data jsonb, root_schema jsonb DEFAULT NULL) RETURNS boolean AS $f$
+DECLARE
+  prop text;
+  item jsonb;
+  path text[];
+  types text[];
+  pattern text;
+  props text[];
+BEGIN
+  IF root_schema IS NULL THEN
+    root_schema = schema;
+  END IF;
+
+  IF schema ? 'type' THEN
+    IF jsonb_typeof(schema->'type') = 'array' THEN
+      types = ARRAY(SELECT jsonb_array_elements_text(schema->'type'));
+    ELSE
+      types = ARRAY[schema->>'type'];
+    END IF;
+    IF (SELECT NOT bool_or(public._validate_json_schema_type(type, data)) FROM unnest(types) type) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'properties' THEN
+    FOR prop IN SELECT jsonb_object_keys(schema->'properties') LOOP
+      IF data ? prop AND NOT validate_json_schema(schema->'properties'->prop, data->prop, root_schema) THEN
+        RETURN false;
+      END IF;
+    END LOOP;
+  END IF;
+
+  IF schema ? 'required' AND jsonb_typeof(data) = 'object' THEN
+    IF NOT ARRAY(SELECT jsonb_object_keys(data)) @>
+           ARRAY(SELECT jsonb_array_elements_text(schema->'required')) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'items' AND jsonb_typeof(data) = 'array' THEN
+    IF jsonb_typeof(schema->'items') = 'object' THEN
+      FOR item IN SELECT jsonb_array_elements(data) LOOP
+        IF NOT validate_json_schema(schema->'items', item, root_schema) THEN
+          RETURN false;
+        END IF;
+      END LOOP;
+    ELSE
+      IF NOT (
+        SELECT bool_and(i > jsonb_array_length(schema->'items') OR validate_json_schema(schema->'items'->(i::int - 1), elem, root_schema))
+        FROM jsonb_array_elements(data) WITH ORDINALITY AS t(elem, i)
+      ) THEN
+        RETURN false;
+      END IF;
+    END IF;
+  END IF;
+
+  IF jsonb_typeof(schema->'additionalItems') = 'boolean' and NOT (schema->'additionalItems')::text::boolean AND jsonb_typeof(schema->'items') = 'array' THEN
+    IF jsonb_array_length(data) > jsonb_array_length(schema->'items') THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF jsonb_typeof(schema->'additionalItems') = 'object' THEN
+    IF NOT (
+        SELECT bool_and(validate_json_schema(schema->'additionalItems', elem, root_schema))
+        FROM jsonb_array_elements(data) WITH ORDINALITY AS t(elem, i)
+        WHERE i > jsonb_array_length(schema->'items')
+      ) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'minimum' AND jsonb_typeof(data) = 'number' THEN
+    IF data::text::numeric < (schema->>'minimum')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'maximum' AND jsonb_typeof(data) = 'number' THEN
+    IF data::text::numeric > (schema->>'maximum')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF COALESCE((schema->'exclusiveMinimum')::text::bool, FALSE) THEN
+    IF data::text::numeric = (schema->>'minimum')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF COALESCE((schema->'exclusiveMaximum')::text::bool, FALSE) THEN
+    IF data::text::numeric = (schema->>'maximum')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'anyOf' THEN
+    IF NOT (SELECT bool_or(validate_json_schema(sub_schema, data, root_schema)) FROM jsonb_array_elements(schema->'anyOf') sub_schema) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'allOf' THEN
+    IF NOT (SELECT bool_and(validate_json_schema(sub_schema, data, root_schema)) FROM jsonb_array_elements(schema->'allOf') sub_schema) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'oneOf' THEN
+    IF 1 != (SELECT COUNT(*) FROM jsonb_array_elements(schema->'oneOf') sub_schema WHERE validate_json_schema(sub_schema, data, root_schema)) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF COALESCE((schema->'uniqueItems')::text::boolean, false) THEN
+    IF (SELECT COUNT(*) FROM jsonb_array_elements(data)) != (SELECT count(DISTINCT val) FROM jsonb_array_elements(data) val) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'additionalProperties' AND jsonb_typeof(data) = 'object' THEN
+    props := ARRAY(
+      SELECT key
+      FROM jsonb_object_keys(data) key
+      WHERE key NOT IN (SELECT jsonb_object_keys(schema->'properties'))
+        AND NOT EXISTS (SELECT * FROM jsonb_object_keys(schema->'patternProperties') pat WHERE key ~ pat)
+    );
+    IF jsonb_typeof(schema->'additionalProperties') = 'boolean' THEN
+      IF NOT (schema->'additionalProperties')::text::boolean AND jsonb_typeof(data) = 'object' AND NOT props <@ ARRAY(SELECT jsonb_object_keys(schema->'properties')) THEN
+        RETURN false;
+      END IF;
+    ELSEIF NOT (
+      SELECT bool_and(validate_json_schema(schema->'additionalProperties', data->key, root_schema))
+      FROM unnest(props) key
+    ) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? '$ref' THEN
+    path := ARRAY(
+      SELECT regexp_replace(regexp_replace(path_part, '~1', '/'), '~0', '~')
+      FROM UNNEST(regexp_split_to_array(schema->>'$ref', '/')) path_part
+    );
+    -- ASSERT path[1] = '#', 'only refs anchored at the root are supported';
+    IF NOT validate_json_schema(root_schema #> path[2:array_length(path, 1)], data, root_schema) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'enum' THEN
+    IF NOT EXISTS (SELECT * FROM jsonb_array_elements(schema->'enum') val WHERE val = data) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'minLength' AND jsonb_typeof(data) = 'string' THEN
+    IF char_length(data #>> '{}') < (schema->>'minLength')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'maxLength' AND jsonb_typeof(data) = 'string' THEN
+    IF char_length(data #>> '{}') > (schema->>'maxLength')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'not' THEN
+    IF validate_json_schema(schema->'not', data, root_schema) THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'maxProperties' AND jsonb_typeof(data) = 'object' THEN
+    IF (SELECT count(*) FROM jsonb_object_keys(data)) > (schema->>'maxProperties')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'minProperties' AND jsonb_typeof(data) = 'object' THEN
+    IF (SELECT count(*) FROM jsonb_object_keys(data)) < (schema->>'minProperties')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'maxItems' AND jsonb_typeof(data) = 'array' THEN
+    IF (SELECT count(*) FROM jsonb_array_elements(data)) > (schema->>'maxItems')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'minItems' AND jsonb_typeof(data) = 'array' THEN
+    IF (SELECT count(*) FROM jsonb_array_elements(data)) < (schema->>'minItems')::numeric THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'dependencies' THEN
+    FOR prop IN SELECT jsonb_object_keys(schema->'dependencies') LOOP
+      IF data ? prop THEN
+        IF jsonb_typeof(schema->'dependencies'->prop) = 'array' THEN
+          IF NOT (SELECT bool_and(data ? dep) FROM jsonb_array_elements_text(schema->'dependencies'->prop) dep) THEN
+            RETURN false;
+          END IF;
+        ELSE
+          IF NOT validate_json_schema(schema->'dependencies'->prop, data, root_schema) THEN
+            RETURN false;
+          END IF;
+        END IF;
+      END IF;
+    END LOOP;
+  END IF;
+
+  IF schema ? 'pattern' AND jsonb_typeof(data) = 'string' THEN
+    IF (data #>> '{}') !~ (schema->>'pattern') THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  IF schema ? 'patternProperties' AND jsonb_typeof(data) = 'object' THEN
+    FOR prop IN SELECT jsonb_object_keys(data) LOOP
+      FOR pattern IN SELECT jsonb_object_keys(schema->'patternProperties') LOOP
+        RAISE NOTICE 'prop %s, pattern %, schema %', prop, pattern, schema->'patternProperties'->pattern;
+        IF prop ~ pattern AND NOT validate_json_schema(schema->'patternProperties'->pattern, data->prop, root_schema) THEN
+          RETURN false;
+        END IF;
+      END LOOP;
+    END LOOP;
+  END IF;
+
+  IF schema ? 'multipleOf' AND jsonb_typeof(data) = 'number' THEN
+    IF data::text::numeric % (schema->>'multipleOf')::numeric != 0 THEN
+      RETURN false;
+    END IF;
+  END IF;
+
+  RETURN true;
+END;
+$f$ LANGUAGE 'plpgsql' IMMUTABLE;

test/fixtures/privileges.sql

@@ -68,6 +68,7 @@ GRANT ALL ON TABLE
     , tiobe_pls
     , only_pk
     , family_tree
+    , managers
     , organizations
     , authors
     , books
@@ -98,6 +99,8 @@ GRANT ALL ON TABLE
     , projects_count_grouped_by
     , "Server Today"
     , pgrst_reserved_chars
+    , authors_w_entities
+    , openapi_types
 TO postgrest_test_anonymous;
 
 GRANT INSERT ON TABLE insertonly TO postgrest_test_anonymous;

test/fixtures/schema.sql

@@ -116,6 +116,11 @@ CREATE FUNCTION always_true(test.items) RETURNS boolean
     LANGUAGE sql STABLE
     AS $$ SELECT true $$;
 
+CREATE FUNCTION is_first(test.items) RETURNS boolean
+    LANGUAGE sql STABLE
+    AS $$ SELECT $1.id = 1 $$;
+
+
 CREATE FUNCTION anti_id(test.items) RETURNS bigint
     LANGUAGE sql STABLE
     AS $_$ SELECT $1.id * -1 $_$;
@@ -176,20 +181,6 @@ CREATE FUNCTION noparamsproc() RETURNS text
 		SELECT a FROM (VALUES ('Return value of no parameters procedure.')) s(a);
 	$$;
 
---
--- Name: insert_insertable_view_with_join(); Type: FUNCTION; Schema: test; Owner: -
---
-
-CREATE FUNCTION insert_insertable_view_with_join() RETURNS trigger
-    LANGUAGE plpgsql
-    AS $$
-begin
-  INSERT INTO test.auto_incrementing_pk (nullable_string, non_nullable_string) VALUES (NEW.nullable_string, NEW.non_nullable_string);
-  RETURN NEW;
-end;
-$$;
-
-
 --
 -- Name: login(text, text); Type: FUNCTION; Schema: test; Owner: -
 --
@@ -215,18 +206,28 @@ CREATE FUNCTION varied_arguments(
   date date,
   money money,
   enum enum_menagerie_type,
-  "integer" integer default 42
+  "integer" integer default 42,
+  json json default '{}',
+  jsonb jsonb default '{}'
 ) RETURNS text
     LANGUAGE sql
 AS $_$
   SELECT 'Hi'::text;
 $_$;
 
-COMMENT ON FUNCTION varied_arguments(double precision, character varying, boolean, date, money, enum_menagerie_type, integer) IS
+COMMENT ON FUNCTION varied_arguments(double precision, character varying, boolean, date, money, enum_menagerie_type, integer, json, jsonb) IS
 $_$An RPC function
 
 Just a test for RPC function arguments$_$;
 
+
+CREATE FUNCTION json_argument(arg json) RETURNS text
+
+LANGUAGE sql
+AS $_$
+  SELECT json_typeof(arg);
+$_$;
+
 --
 -- Name: jwt_test(); Type: FUNCTION; Schema: test; Owner: -
 --
@@ -964,13 +965,6 @@ CREATE TRIGGER articles_owner_track BEFORE INSERT OR UPDATE ON articles FOR EACH
 
 SET search_path = test, pg_catalog;
 
---
--- Name: insert_insertable_view_with_join; Type: TRIGGER; Schema: test; Owner: -
---
-
-CREATE TRIGGER insert_insertable_view_with_join INSTEAD OF INSERT ON insertable_view_with_join FOR EACH ROW EXECUTE PROCEDURE insert_insertable_view_with_join();
-
-
 --
 -- Name: secrets_owner_track; Type: TRIGGER; Schema: test; Owner: -
 --
@@ -1115,8 +1109,8 @@ CREATE FUNCTION setprojects(id_l int, id_h int, name text) RETURNS SETOF project
 $_$;
 
 create table images (
-	name               text not null,
-	img                bytea not null
+	name text  not null,
+	img  bytea not null
 );
 
 create view images_base64 as (
@@ -1386,11 +1380,17 @@ create table test.family_tree (
 );
 alter table only test.family_tree add constraint pptr foreign key (parent) references test.family_tree(id);
 
+create table test.managers (
+  id integer primary key,
+  name text
+);
+
 create table test.organizations (
   id integer primary key,
   name text,
   referee integer,
-  auditor integer
+  auditor integer,
+  manager_id integer references managers(id)
 );
 alter table only test.organizations add constraint pptr1 foreign key (referee) references test.organizations(id);
 alter table only test.organizations add constraint pptr2 foreign key (auditor) references test.organizations(id);
@@ -1560,6 +1560,19 @@ select
 from projects
 group by client_id;
 
+create view test.authors_w_entities as
+select
+  id,
+  name,
+  (
+    select json_agg(id)
+    from test.entities
+    where id not in (
+      select parent_id from test.child_entities
+    )
+  ) as entities
+from private.authors;
+
 CREATE TABLE test."Foo"(
   id int primary key,
   name text
@@ -1649,3 +1662,71 @@ create table test.pgrst_reserved_chars (
   "a.dotted.column" text,
   "  col  w  space  " text
 );
+
+CREATE TABLE test.openapi_types(
+  "a_character_varying" character varying,
+  "a_character" character(1),
+  "a_text" text,
+  "a_boolean" boolean,
+  "a_smallint" smallint,
+  "a_integer" integer,
+  "a_bigint" bigint,
+  "a_numeric" numeric,
+  "a_real" real,
+  "a_double_precision" double precision
+);
+
+create function add_them(a integer, b integer)
+returns integer as $$
+  select a + b;
+$$ language sql;
+
+create function root() returns jsonb as $_$
+declare
+openapi jsonb = $$
+  {
+    "swagger": "2.0",
+    "info":{
+      "title":"PostgREST API",
+      "description":"This is a dynamic API generated by PostgREST"
+    }
+  }
+$$;
+simple jsonb = $$
+  [
+    {
+      "table":"items"
+    },
+    {
+      "table":"subitems"
+    }
+  ]
+$$;
+begin
+case current_setting('request.header.accept', true)
+  when 'application/openapi+json' then
+    return openapi;
+  when 'application/json' then
+    return simple;
+  else
+    return openapi;
+  end case;
+end
+$_$ language plpgsql;
+
+create or replace function welcome() returns text as $$
+select 'Welcome to PostgREST'::text;
+$$ language sql;
+
+create or replace function "welcome.html"() returns text as $_$
+select $$
+<html>
+  <head>
+    <title>PostgREST</title>
+  </head>
+  <body>
+    <h1>Welcome to PostgREST</h1>
+  </body>
+</html>
+$$::text;
+$_$ language sql;

test/io-tests.sh

@@ -74,7 +74,7 @@ readSecretFromFile(){
     then
       ok "authentication with $2 secret read from a file"
     else
-      ko "failed to authenticate using JWT for $2 secret: $httpStatus"
+      ko "authentication with $2 secret read from a file: $httpStatus"
     fi
   else
     ko "failed to read $2 secret from a file"
@@ -95,7 +95,7 @@ readDbUriFromFile(){
   then
     ok "connection with $2 dburi read from a file"
   else
-    ko "failed to read $2 dburi from a file"
+    ko "connection with $2 dburi read from a file"
   fi
   pgrStop
 }
@@ -113,9 +113,9 @@ reqWithRoleClaimKey(){
   httpStatus="$( authorsStatus "$authorsJwt" )"
   if test "$httpStatus" -eq $3
   then
-    ok "request with \"$1\" role-claim-key for $2 jwt gave $3"
+    ok "request with \"$1\" role-claim-key for $2 jwt: $httpStatus"
   else
-    ko "request with \"$1\" role-claim-key for $2 jwt gave $httpStatus"
+    ko "request with \"$1\" role-claim-key for $2 jwt: $httpStatus"
   fi
   pgrStop
 }
@@ -131,9 +131,9 @@ invalidRoleClaimKey(){
   done
   if pgrStarted
   then
-    ko "invalid jspath \"$1\" accepted"
+    ko "invalid jspath \"$1\": accepted"
   else
-    ok "invalid jspath \"$1\" rejected"
+    ok "invalid jspath \"$1\": rejected"
   fi
   pgrStop
 }
@@ -152,12 +152,12 @@ ensureIatClaimWorks(){
     httpStatus="$( authorsStatus $iatJwt )"
     if test "$httpStatus" -ne 200
     then
-      ko "iat claim rejected with $httpStatus"
+      ko "iat claim rejected: $httpStatus"
       return
     fi
     sleep .5;\
   done
-  ok "accepted iat claim"
+  ok "iat claim accepted"
   pgrStop
 }
 
@@ -174,9 +174,33 @@ ensureAppSettings(){
   response=$(curl -s "http://localhost:$pgrPort/rpc/get_guc_value?name=app.settings.external_api_secret")
   if test "$response" = "\"0123456789abcdef\""
   then
-    ok "GET /rpc/get_guc_value response is $response"
+    ok "GET /rpc/get_guc_value: $response"
   else
-    ko "GET /rpc/get_guc_value response was $response"
+    ko "GET /rpc/get_guc_value: $response"
+  fi
+  pgrStop
+}
+
+getSocketStatus() {
+  curl -sL -w "%{http_code}\\n" -o /dev/null localhost:54321
+}
+
+socketConnection(){
+  # map port 54321 traffic to unix socket as workaround for curl below 7.40
+  # not supporting --unix-socket flag
+  ncat -vlk 54321 -c 'ncat -U /tmp/postgrest.sock' &
+  pgrStart "./configs/unix-socket.config"
+  while pgrStarted && test "$( getSocketStatus )" -ne 200
+  do
+    # wait for the server to start
+    sleep 0.1 \
+    || sleep 1 # fallback: subsecond sleep is not standard and may fail
+  done
+  if test $( getSocketStatus ) -eq 200
+  then
+    ok "Succesfully connected through unix socket"
+  else
+    ko "Failed to connect through unix socket"
   fi
   pgrStop
 }
@@ -191,6 +215,8 @@ setUp
 
 echo "Running IO tests.."
 
+socketConnection
+
 readSecretFromFile word.noeol 'simple (no EOL)'
 readSecretFromFile word.txt 'simple'
 readSecretFromFile ascii.noeol 'ASCII (no EOL)'
@@ -224,6 +250,7 @@ invalidRoleClaimKey 1234
 ensureIatClaimWorks
 ensureAppSettings
 
+
 cleanUp
 
 exit $failedTests

test/io-tests/configs/unix-socket.config

@@ -0,0 +1,7 @@
+db-uri = "postgres:///postgrest_test"
+db-schema = "test"
+db-anon-role = "postgrest_test_anonymous"
+db-pool = 1
+server-host = "127.0.0.1"
+server-unix-socket = "/tmp/postgrest.sock"
+jwt-secret = "reallyreallyreallyreallyverysafe"

test/memory-tests.sh

@@ -90,27 +90,25 @@ postJsonArrayTest(){
   fi
 }
 
-stack build --profile
-
 setUp
 
 echo "Running memory usage tests.."
 
-jsonKeyTest "1M" "POST" "/rpc/leak" "20M"
-jsonKeyTest "1M" "POST" "/leak" "20M"
-jsonKeyTest "1M" "PATCH" "/leak?id=eq.1" "20M"
+jsonKeyTest "1M" "POST" "/rpc/leak?columns=blob" "12M"
+jsonKeyTest "1M" "POST" "/leak?columns=blob" "12M"
+jsonKeyTest "1M" "PATCH" "/leak?id=eq.1&columns=blob" "12M"
 
-jsonKeyTest "10M" "POST" "/rpc/leak" "105M"
-jsonKeyTest "10M" "POST" "/leak" "105M"
-jsonKeyTest "10M" "PATCH" "/leak?id=eq.1" "105M"
+jsonKeyTest "10M" "POST" "/rpc/leak?columns=blob" "40M"
+jsonKeyTest "10M" "POST" "/leak?columns=blob" "40M"
+jsonKeyTest "10M" "PATCH" "/leak?id=eq.1&columns=blob" "40M"
 
-jsonKeyTest "50M" "POST" "/rpc/leak" "500M"
-jsonKeyTest "50M" "POST" "/leak" "500M"
-jsonKeyTest "50M" "PATCH" "/leak?id=eq.1" "500M"
+jsonKeyTest "50M" "POST" "/rpc/leak?columns=blob" "170M"
+jsonKeyTest "50M" "POST" "/leak?columns=blob" "170M"
+jsonKeyTest "50M" "PATCH" "/leak?id=eq.1&columns=blob" "170M"
 
-postJsonArrayTest "1000" "/perf_articles" "20M"
-postJsonArrayTest "10000" "/perf_articles" "150M"
-postJsonArrayTest "100000" "/perf_articles" "1.15G"
+postJsonArrayTest "1000" "/perf_articles?columns=id,body" "10M"
+postJsonArrayTest "10000" "/perf_articles?columns=id,body" "10M"
+postJsonArrayTest "100000" "/perf_articles?columns=id,body" "20M"
 
 cleanUp