Merge branch 'build-0.4.1.0'

Re-enable openapi tests on CI
Revert "Fix swagger-ui when "server-proxy-uri" is not set (#857 )"
2017-04-30 00:06:25 -05:00 · 2017-04-29 21:07:42 -05:00 · 2017-04-29 21:02:14 -05:00 · 2017-04-29 21:02:14 -05:00 · 2017-04-19 19:12:58 -05:00 · 2017-04-13 17:31:14 -05:00
40 changed files with 1128 additions and 657 deletions
@@ -0,0 +1 @@
+/CHANGELOG.md merge=union
@@ -9,6 +9,24 @@ This project adheres to [Semantic Versioning](http://semver.org/).

 ### Fixed

+## [0.4.1.0] - 2017-04-25
+
+### Added
+- Allow requesting binary output on GET - @steve-chavez
+- Accept clients requesting `Content-Type: application/json` from / - @feynmanliang
+- #493, Updating with empty JSON object makes zero updates @koulakis
+- Make HTTP headers and cookies available as GUCs #800 - @ruslantalpa
+- #701, Ability to quote values on IN filters - @steve-chavez
+- #641, Allow IN filter to have no values - @steve-chavez
+
+### Fixed
+- #827, Avoid Warp reaper, extend socket timeout to 1 hour - @majorcode
+- #791, malformed nested JSON error - @diogob
+- Resource embedding in views referencing tables in public schema - @fab1an
+- #777, Empty body is allowed when calling a non-parameterized RPC - @koulakis
+- #831, Fix proc resource embedding issue with search_path - @steve-chavez
+- #547, Use read-only transaction for stable/immutable RPC - @begriffs
+
 ## [0.4.0.0] - 2017-01-19

 ### Added
@@ -61,3 +61,9 @@ my other obligations.  If you don't get a response right away
 don't worry, I will definitely get to it. Also you can join the
 Gitter [chat room](https://gitter.im/begriffs/postgrest) to
 discuss issues you are having.
+
+## Running Tests
+
+For instructions on running tests, see the official docs hosted here:
+
+https://postgrest.com/en/v0.4/install.html#postgrest-test-suite
@@ -1,11 +1,11 @@
 ![Logo](static/logo.png "Logo")

 [![Build Status](https://circleci.com/gh/begriffs/postgrest.png?style=shield&circle-token=f723c01686abf0364de1e2eaae5aff1f68bd3ff2)](https://circleci.com/gh/begriffs/postgrest/tree/master)
-<a href="https://heroku.com/deploy?template=https://github.com/begriffs/postgrest">
+<a href="https://heroku.com/deploy?template=https://github.com/begriffs/postgrest/tree/new-heroku">
  <img src="https://img.shields.io/badge/%E2%86%91_Deploy_to-Heroku-7056bf.svg" alt="Deploy">
 </a>
 [![Join the chat at https://gitter.im/begriffs/postgrest](https://img.shields.io/badge/gitter-join%20chat%20%E2%86%92-brightgreen.svg)](https://gitter.im/begriffs/postgrest)
-[![Docs](https://img.shields.io/badge/docs-latest-brightgreen.svg?style=flat)](https://postgrest.com)
+[![Docs](https://img.shields.io/badge/docs-latest-brightgreen.svg?style=flat)](http://postgrest.com)

 PostgREST serves a fully RESTful API from any existing PostgreSQL
 database. It provides a cleaner, more standards-compliant, faster
@@ -10,47 +10,46 @@
    },
    "POSTGREST_VER": {
      "description": "Version of PostgREST to deploy",
-      "value": "0.4.0.0"
+      "value": "0.4.1.0"
    },
-    "DB_NAME": {
-      "description": "Database name",
+    "DB_URI": {
+      "description": "Database connection string",
      "required": true
    },
-    "AUTH_ROLE": {
-      "description": "Database role to use checking client authentication",
+    "DB_SCHEMA": {
+      "description": "The database schema to expose to REST clients. Tables, views and stored procedures in this schema will get API endpoints",
+      "required": true,
+      "value": "public"
+    },
+    "DB_ANON_ROLE": {
+      "description": "The database role to use when executing commands on behalf of unauthenticated clients",
      "required": true
    },
-    "AUTH_PASS": {
-      "description": "Authentication password",
-      "required": false
-    },
-    "ANONYMOUS_ROLE": {
-      "description": "Database role for non-authenticated requests",
-      "required": true
-    },
-    "DB_HOST": {
-      "description": "Database server hostname",
-      "required": true
-    },
-    "DB_PORT": {
-      "description": "Database server port",
-      "required": false,
-      "value": "5432"
-    },
    "DB_POOL": {
-      "description": "Maximum number of connections in database pool",
+      "description": "Number of connections to keep open in PostgREST’s database pool",
      "required": false,
      "value": "10"
    },
-    "JWT_SECRET": {
-      "description": "Secret used to encrypt JSON Web Tokens",
-      "required": false,
-      "value": "secret"
+    "SERVER_PROXY_URI": {
+      "description": "Overrides the base URL used within the OpenAPI self-documentation hosted at the API root path",
+      "required": false
    },
-    "SCHEMA": {
-      "description": "DB schema to be exported",
+    "JWT_SECRET": {
+      "description": "The secret used to decode JWT tokens clients provide for authentication",
+      "required": false
+    },
+    "SECRET_IS_BASE64": {
+      "description": "When this is set to true, the value derived from jwt-secret will be treated as a base64 encoded secret",
      "required": false,
-      "value": "1"
+      "value": "false"
+    },
+    "MAX_ROWS": {
+      "description": "A hard limit to the number of rows PostgREST will fetch from a view, table, or stored procedure",
+      "required": false
+    },
+    "PRE_REQUEST": {
+      "description": "A schema-qualified stored procedure name to call right after switching roles for a client request",
+      "required": false
    }
  }
 }
@@ -15,7 +15,7 @@ dependencies:

 test:
  override:
-    - POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://ubuntu@localhost" postgrest_test) stack test --test-arguments "--skip \"returns a valid openapi\""
+    - POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://ubuntu@localhost" postgrest_test) stack test
    - git ls-files | grep '\.l\?hs$' | xargs stack exec -- hlint -X QuasiQuotes -X NoPatternSynonyms "$@"
    - stack exec -- cabal update
    - stack exec --no-ghc-package-path -- cabal install --only-d --dry-run
@@ -1,6 +1,6 @@
 FROM debian:jessie

-ENV POSTGREST_VERSION 0.4.0.0
+ENV POSTGREST_VERSION 0.4.1.0

 RUN apt-get update && \
    apt-get install -y tar xz-utils wget libpq-dev && \
@@ -13,6 +13,6 @@ RUN wget http://github.com/begriffs/postgrest/releases/download/v${POSTGREST_VER

 # PostgREST reads /etc/postgrest.conf so map the configuration
 # file in when you run this container
-CMD exec postgrest
+CMD exec postgrest /etc/postgrest.conf

 EXPOSE 3000
@@ -0,0 +1,3 @@
+db-uri = "postgres://app_user:password@postgres:5432/app_db"
+db-schema = "public"
+db-anon-role = "app_user"
@@ -0,0 +1,17 @@
+stgrest:
+  image: begriffs/postgrest:latest
+  ports:
+    - "3000:3000"
+  volumes:
+    - ./config.conf:/etc/postgrest.conf
+  links:
+    - postgres:postgres
+
+postgres:
+  image: postgres
+  ports:
+    - "5432:5432"
+  environment:
+    POSTGRES_DB: app_db
+    POSTGRES_USER: app_user
+    POSTGRES_PASSWORD: password
@@ -9,7 +9,7 @@ import           PostgREST.Config                     (AppConfig (..),
                                                       minimumPgVersion,
                                                       prettyVersion,
                                                       readOptions)
-import           PostgREST.Error                      (prettyUsageError)
+import           PostgREST.Error                      (encodeError)
 import           PostgREST.OpenAPI                    (isMalformedProxyUri)
 import           PostgREST.DbStructure

@@ -57,6 +57,7 @@ main = do
      appSettings = setHost ((fromString . toS) host)
                  . setPort port
                  . setServerName (toS $ "postgrest/" <> prettyVersion)
+                  . setTimeout 3600
                  $ defaultSettings

  when (isMalformedProxyUri $ toS <$> proxy) $ panic
@@ -74,7 +75,7 @@ main = do
    getDbStructure (toS $ configSchema conf)

  forM_ (lefts [result]) $ \e -> do
-    hPutStrLn stderr (prettyUsageError e)
+    hPutStrLn stderr (toS $ encodeError e)
    exitFailure

  refDbStructure <- newIORef $ either (panic . show) id result
@@ -124,4 +125,3 @@ loadSecretFile conf = extractAndTransform mSecret
    setSecret bs = conf { configJwtSecret = Just bs }

    replaceUrlChars = replace "_" "/" . replace "-" "+" . replace "." "="
-        
@@ -2,7 +2,7 @@ name:                  postgrest
 description:           Reads the schema of a PostgreSQL database and creates RESTful routes
                       for the tables and views, supporting all HTTP verbs that security
                       permits.
-version:               0.4.0.0
+version:               0.4.1.0
 synopsis:              REST API for any Postgres database
 license:               MIT
 license-file:          LICENSE
@@ -70,7 +70,7 @@ library
                     , lens
                     , lens-aeson
                     , network-uri
-                     , optparse-applicative >= 0.12.0.0 && < 0.13.0.0
+                     , optparse-applicative >= 0.13 && < 0.14
                     , parsec
                     , protolude
                     , Ranged-sets == 0.3.0
@@ -86,6 +86,7 @@ library
                     , wai-cors
                     , wai-extra
                     , wai-middleware-static
+                     , cookie

  Other-Modules:       Paths_postgrest
  Exposed-Modules:     PostgREST.ApiRequest
@@ -143,7 +144,7 @@ Test-Suite spec
                     , hjsonpointer
                     , hjsonschema
                     , hspec
-                     , hspec-wai
+                     , hspec-wai >= 0.7.0
                     , hspec-wai-json
                     , http-types
                     , lens
@@ -3,19 +3,17 @@ Module      : PostgREST.ApiRequest
 Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
 -}
 module PostgREST.ApiRequest ( ApiRequest(..)
-                            , ApiRequestError(..)
                            , ContentType(..)
                            , Action(..)
                            , Target(..)
                            , PreferRepresentation (..)
                            , mutuallyAgreeable
-                            , toHeader
                            , userApiRequest
-                            , toMime
                            ) where

 import           Protolude
 import qualified Data.Aeson                as JSON
+import           Data.Aeson.Types          (emptyObject)
 import qualified Data.ByteString           as BS
 import qualified Data.ByteString.Internal  as BS (c2w)
 import qualified Data.ByteString.Lazy      as BL
@@ -29,16 +27,21 @@ 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, hContentType, Header)
+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           (QualifiedIdentifier (..),
-                                            Schema,
-                                            PayloadJSON(..))
+import           PostgREST.Types           ( QualifiedIdentifier (..)
+                                           , Schema
+                                           , PayloadJSON(..)
+                                           , ContentType(..)
+                                           , ApiRequestError(..)
+                                           , toMime)
 import           Data.Ranged.Ranges        (Range(..), rangeIntersection, emptyRange)
+import qualified Data.CaseInsensitive      as CI
+import           Web.Cookie                (parseCookiesText)

 type RequestBody = BL.ByteString

@@ -57,29 +60,6 @@ data Target = TargetIdent QualifiedIdentifier
 -- | How to return the inserted data
 data PreferRepresentation = Full | HeadersOnly | None deriving Eq
                          --
-- | Enumeration of currently supported response content types
-data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI
-                 | CTSingularJSON
-                 | CTAny | CTOther BS.ByteString deriving Eq
-
-data ApiRequestError = ErrorActionInappropriate
-                     | ErrorInvalidBody ByteString
-                     | ErrorInvalidRange
-                     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 CTOpenAPI         = "application/openapi+json"
-toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
-toMime CTAny             = "*/*"
-toMime (CTOther ct)      = ct
-
 {-|
  Describes what the user wants to do. This data type is a
  translation of the raw elements of an HTTP request into domain
@@ -114,14 +94,18 @@ data ApiRequest = ApiRequest {
  , iCanonicalQS :: ByteString
  -- | JSON Web Token
  , iJWT :: Text
+  -- | HTTP request headers
+  , iHeaders :: [(Text, Text)]
+  -- | Request Cookies
+  , iCookies :: [(Text, Text)]
  }

 -- | Examines HTTP request and translates it into user intent.
 userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest
 userApiRequest schema req reqBody
-  | isTargetingProc && method /= "POST" = Left ErrorActionInappropriate
-  | topLevelRange == emptyRange = Left ErrorInvalidRange
-  | shouldParsePayload && isLeft payload = either (Left . ErrorInvalidBody . toS) undefined payload
+  | isTargetingProc && method /= "POST" = Left ActionInappropriate
+  | topLevelRange == emptyRange = Left InvalidRange
+  | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) undefined payload
  | otherwise = Right ApiRequest {
      iAction = action
      , iTarget = target
@@ -141,19 +125,21 @@ userApiRequest schema req reqBody
        . parseSimpleQuery
        $ rawQueryString req
      , iJWT = tokenStr
+      , iHeaders = [ (toS $ CI.foldedCase k, toS v) | (k,v) <- hdrs, k /= hAuthorization, k /= hCookie]
+      , iCookies = fromMaybe [] $ parseCookiesText <$> lookupHeader "Cookie"
      }
 where
  isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path
  payload =
    case decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type" of
      CTApplicationJSON ->
-          either Left (\val -> case ensureUniform (pluralize val) of
-            Nothing -> Left "All object keys must match"
-            Just json -> Right json) (JSON.eitherDecode reqBody)
+        note "All object keys must match" . ensureUniform . pluralize
+          =<< if BL.null reqBody && isTargetingProc
+               then Right emptyObject
+               else JSON.eitherDecode reqBody
      CTTextCSV ->
-          either Left (\val -> case ensureUniform (csvToJson val) of
-            Nothing -> Left "All lines must have same number of fields"
-            Just json -> Right json) (CSV.decodeByName reqBody)
+        note "All lines must have same number of fields" . ensureUniform . csvToJson
+          =<< CSV.decodeByName reqBody
      CTOther "application/x-www-form-urlencoded" ->
        Right . PayloadJSON . V.singleton . M.fromList
                    . map (toS *** JSON.String . toS) . parseSimpleQuery
@@ -247,6 +233,7 @@ decodeContentType ct =
    "application/openapi+json"          -> CTOpenAPI
    "application/vnd.pgrst.object+json" -> CTSingularJSON
    "application/vnd.pgrst.object"      -> CTSingularJSON
+    "application/octet-stream"          -> CTOctetStream
    "*/*"                               -> CTAny
    ct'                                 -> CTOther ct'

@@ -8,6 +8,7 @@ module PostgREST.App (

 import           Control.Applicative
 import qualified Data.ByteString.Char8     as BS
+import           Data.Maybe
 import           Data.IORef                (IORef, readIORef)
 import           Data.Text                 (intercalate)
 import           Data.Time.Clock.POSIX     (POSIXTime)
@@ -32,15 +33,19 @@ import           PostgREST.ApiRequest   ( ApiRequest(..), ContentType(..)
                                        , Action(..), Target(..)
                                        , PreferRepresentation (..)
                                        , mutuallyAgreeable
-                                        , toHeader
                                        , userApiRequest
-                                        , toMime
                                        )
 import           PostgREST.Auth            (jwtClaims, containsRole)
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.DbStructure
-import           PostgREST.DbRequestBuilder(readRequest, mutateRequest)
-import           PostgREST.Error           (errResponse, pgErrResponse, apiRequestErrResponse, singularityError)
+import           PostgREST.DbRequestBuilder( readRequest
+                                           , mutateRequest
+                                           , fieldNames
+                                           )
+import           PostgREST.Error           ( simpleError, pgError
+                                           , apiRequestError
+                                           , singularityError, binaryFieldError
+                                           )
 import           PostgREST.RangeQuery      (allRange, rangeOffset)
 import           PostgREST.Middleware
 import           PostgREST.QueryBuilder ( callProc
@@ -54,7 +59,8 @@ import           PostgREST.Types
 import           PostgREST.OpenAPI

 import           Data.Function (id)
-import           Protolude                hiding (intercalate, Proxy)
+import           Protolude              hiding (intercalate, Proxy)
+import           Safe                   (headMay)

 postgrest :: AppConfig -> IORef DbStructure -> P.Pool -> IO POSIXTime ->
             Application
@@ -67,21 +73,35 @@ postgrest conf refDbStructure pool getTime =
    dbStructure <- readIORef refDbStructure

    response <- case userApiRequest (configSchema conf) req body of
-      Left err -> return $ apiRequestErrResponse err
+      Left err -> return $ apiRequestError err
      Right apiRequest -> do
        let jwtSecret = binarySecret <$> configJwtSecret conf
            eClaims = jwtClaims jwtSecret (iJWT apiRequest) time
            authed = containsRole eClaims
            handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
-            txMode = transactionMode $ iAction apiRequest
+            txMode = transactionMode dbStructure
+              (iTarget apiRequest) (iAction apiRequest)
        response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq
-        return $ either (pgErrResponse authed) identity response
+        return $ either (pgError authed) identity response
    respond response

-transactionMode :: Action -> H.Mode
-transactionMode ActionRead = HT.Read
-transactionMode ActionInfo = HT.Read
-transactionMode _ = HT.Write
+transactionMode :: DbStructure -> Target -> Action -> H.Mode
+transactionMode structure target action =
+  case action of
+    ActionRead -> HT.Read
+    ActionInfo -> HT.Read
+    ActionInspect -> HT.Read
+    ActionInvoke ->
+      let proc =
+            case target of
+              (TargetProc qi) -> M.lookup (qiName qi) $
+                                   dbProcs structure
+              _               -> Nothing
+          v = fromMaybe Volatile $ pdVolatility <$> proc in
+      if v == Stable || v == Immutable
+         then HT.Read
+         else HT.Write
+    _ -> HT.Write

 app :: DbStructure -> AppConfig -> ApiRequest -> H.Transaction Response
 app dbStructure conf apiRequest =
@@ -91,10 +111,13 @@ app dbStructure conf apiRequest =
      case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of

        (ActionRead, TargetIdent qi, Nothing) ->
-          case readSqlParts of
+          let partsField = (,) <$> readSqlParts
+                <*> (binaryField contentType =<< fldNames) in
+          case partsField of
            Left errorResponse -> return errorResponse
-            Right (q, cq) -> do
-              let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount (contentType == CTTextCSV)
+            Right ((q, cq), bField) -> do
+              let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount
+                                            (contentType == CTTextCSV) bField
              row <- H.query () stm
              let (tableTotal, queryTotal, _ , body) = row
                  (status, contentRange) = rangeHeader queryTotal tableTotal
@@ -142,10 +165,12 @@ app dbStructure conf apiRequest =
                    if iPreferRepresentation apiRequest == Full
                      then toS body else ""

-        (ActionUpdate, TargetIdent _, Just payload) ->
-          case mutateSqlParts of
-            Left errorResponse -> return errorResponse
-            Right (sq, mq) -> do
+        (ActionUpdate, TargetIdent _, Just payload@(PayloadJSON rows)) ->
+          case (mutateSqlParts, null <$> rows V.!? 0, iPreferRepresentation apiRequest == Full) of
+            (Left errorResponse, _, _) -> return errorResponse
+            (_, Just True, True) -> return $ responseLBS status200 [contentRangeH 1 0 Nothing] "[]"
+            (_, Just 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) []
@@ -223,7 +248,7 @@ app dbStructure conf apiRequest =
              uri Nothing = ("http", host, port, "/")
              uri (Just Proxy { proxyScheme = s, proxyHost = h, proxyPort = p, proxyPath = b }) = (s, h, p, b)
              uri' = uri proxy
-              encodeApi ti = encodeOpenAPI (map snd $ dbProcs dbStructure) ti uri'
+              encodeApi ti = encodeOpenAPI (M.elems $ dbProcs dbStructure) ti uri'
          body <- encodeApi . toTableInfo <$> H.query schema accessibleTables
          return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body

@@ -241,7 +266,6 @@ app dbStructure conf apiRequest =
      filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk
      filterCol :: Schema -> TableName -> Column -> Bool
      filterCol sc tb Column{colTable=Table{tableSchema=s, tableName=t}} = s==sc && t==tb
-      filterCol _ _ _ =  False
      allPrKeys = dbPrimaryKeys dbStructure
      allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
      jsonH = toHeader CTApplicationJSON
@@ -255,10 +279,10 @@ app dbStructure conf apiRequest =
            status = rangeStatus lower upper (toInteger <$> tableTotal)
        in (status, contentRange)

-      mapSnd f (a, b) = (a, f b)
-      readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) (map (mapSnd pdReturnType) $ dbProcs dbStructure) apiRequest
+      readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) (dbProcs dbStructure) apiRequest
+      fldNames = fieldNames <$> readReq
      readDbRequest = DbRead <$> readReq
-      mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< readReq)
+      mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< fldNames)
      selectQuery = requestToQuery schema False <$> readDbRequest
      mutateQuery = requestToQuery schema False <$> mutateDbRequest
      countQuery = requestToCountQuery schema <$> readDbRequest
@@ -270,21 +294,30 @@ responseContentTypeOrError accepts action = serves contentTypesForRequest accept
  where
    contentTypesForRequest =
      case action of
-        ActionRead ->    [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionRead ->    [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
        ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
        ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
        ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
        ActionInvoke ->  [CTApplicationJSON, CTSingularJSON]
-        ActionInspect -> [CTOpenAPI]
+        ActionInspect -> [CTOpenAPI, CTApplicationJSON]
        ActionInfo ->    [CTTextCSV]
    serves sProduces cAccepts =
      case mutuallyAgreeable sProduces cAccepts of
        Nothing -> do
          let failed = intercalate ", " $ map (toS . toMime) cAccepts
-          Left $ errResponse status415 $
+          Left $ simpleError status415 $
            "None of these Content-Types are available: " <> failed
        Just ct -> Right ct

+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
+
 splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString)
 splitKeyValue kv = (k, BS.tail v)
  where (k, v) = BS.break (== '=') kv
@@ -12,8 +12,7 @@ In the test suite there is an example of simple login function that can be used
 very simple authentication system inside the PostgreSQL database.
 -}
 module PostgREST.Auth (
-    claimsToSQL
-  , containsRole
+    containsRole
  , jwtClaims
  , tokenJWT
  , JWTAttempt(..)
@@ -28,24 +27,8 @@ import qualified Data.Vector             as V
 import qualified Data.HashMap.Strict     as M
 import           Data.Maybe              (fromJust)
 import           Data.Time.Clock         (NominalDiffTime)
-import           PostgREST.QueryBuilder  (pgFmtIdent, pgFmtLit, unquoted)
 import qualified Web.JWT                 as JWT

-{-|
-  Receives a map of JWT claims and returns a list of PostgreSQL
-  statements to set the claims as user defined GUCs.  Except if we
-  have a claim called role, this one is mapped to a SET ROLE
-  statement.
-}
-claimsToSQL :: M.HashMap Text Value -> [ByteString]
-claimsToSQL claims = roleStmts <> varStmts
- where
-  roleStmts = maybeToList $
-    (\r -> "set local role " <> r <> ";") . toS . valueToVariable <$> M.lookup "role" claims
-  varStmts = map setVar $ M.toList (M.delete "role" claims)
-  setVar (k, val) = "set local " <> toS (pgFmtIdent $ "request.jwt.claim." <> k)
-                    <> " = " <> toS (valueToVariable val) <> ";"
-  valueToVariable = pgFmtLit . unquoted

 {-|
  Possible situations encountered with client JWTs
@@ -29,6 +29,7 @@ import qualified Data.CaseInsensitive        as CI
 import qualified Data.Configurator           as C
 import qualified Data.Configurator.Types     as C
 import           Data.List                   (lookup)
+import           Data.Monoid
 import           Data.Text                   (strip, intercalate, lines)
 import           Data.Text.Encoding          (encodeUtf8)
 import           Data.Text.IO                (hPutStrLn)
@@ -39,9 +40,8 @@ import           Options.Applicative hiding  (str)
 import           Paths_postgrest             (version)
 import           Text.Heredoc
 import           Text.PrettyPrint.ANSI.Leijen hiding ((<>), (<$>))
-
-import           Protolude hiding            (intercalate
-                                             , (<>))
+import qualified Text.PrettyPrint.ANSI.Leijen as L
+import           Protolude hiding            (intercalate, (<>))

 -- | Config file settings for the server
 data AppConfig = AppConfig {
@@ -128,7 +128,7 @@ readOptions = do
             )
           <> footerDoc (Just $
               text "Example Config File:"
-               <> nest 2 (hardline <> exampleCfg)
+               L.<> nest 2 (hardline L.<> exampleCfg)
             )

  parserPrefs = prefs showHelpOnError
@@ -143,6 +143,8 @@ readOptions = do
  missingKeyHint (C.KeyError n) = do
    hPutStrLn stderr $
      "Required config parameter \"" <> n <> "\" is missing or of wrong type.\n" <>
+      "Documentation for configuration options available at\n" <>
+      "\thttp://postgrest.com/en/v0.4/admin.html#configuration\n\n" <>
      "Try the --example-config option to see how to configure PostgREST."
    exitFailure

@@ -2,31 +2,30 @@
 module PostgREST.DbRequestBuilder (
  readRequest
 , mutateRequest
+, fieldNames
 ) where

 import           Control.Applicative
 import           Control.Lens.Getter       (view)
 import           Control.Lens.Tuple        (_1)
 import qualified Data.ByteString.Char8     as BS
-import           Data.List                 (delete, lookup)
+import           Data.List                 (delete)
 import           Data.Maybe                (fromJust)
-import           Data.Text                 (isInfixOf, dropWhile, drop)
+import           Data.Text                 (isInfixOf)
 import           Data.Tree
 import           Data.Either.Combinators   (mapLeft)

-import           Text.Parsec.Error
-
-import           Network.HTTP.Types.Status
 import           Network.Wai

 import           Data.Foldable (foldr1)
 import qualified Data.HashMap.Strict       as M

-import           PostgREST.ApiRequest   ( ApiRequest(..) 
+import           PostgREST.ApiRequest   ( ApiRequest(..)
+                                        , PreferRepresentation(..)
                                        , Action(..), Target(..)
                                        , PreferRepresentation (..)
                                        )
-import           PostgREST.Error           (errResponse, formatParserError)
+import           PostgREST.Error           (apiRequestError)
 import           PostgREST.Parsers
 import           PostgREST.RangeQuery      (NonnegRange, restrictRange)
 import           PostgREST.QueryBuilder (getJoinConditions, sourceCTEName)
@@ -36,31 +35,31 @@ import           Protolude                hiding (from, dropWhile, drop)
 import           Text.Regex.TDFA         ((=~))
 import           Unsafe                  (unsafeHead)

-readRequest :: Maybe Integer -> [Relation] -> [(Text, Text)] -> ApiRequest -> Either Response ReadRequest
+readRequest :: Maybe Integer -> [Relation] -> M.HashMap Text ProcDescription -> ApiRequest -> Either Response ReadRequest
 readRequest maxRows allRels allProcs apiRequest  =
-  mapLeft (errResponse status400) $
+  mapLeft apiRequestError $
  treeRestrictRange maxRows =<<
  augumentRequestWithJoin schema relations =<<
-  first formatParserError parseReadRequest
+  parseReadRequest
  where
    (schema, rootTableName) = fromJust $ -- Make it safe
      let target = iTarget apiRequest in
      case target of
        (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
-        (TargetProc  (QualifiedIdentifier s p) ) -> Just (s, t)
+        (TargetProc  (QualifiedIdentifier s proc) ) -> Just (s, tName)
          where
-            returnType = fromMaybe "" $ lookup p allProcs
-            -- we are looking for results looking like "SETOF schema.tablename" and want to extract tablename
-            t = if "SETOF " `isInfixOf` returnType
-              then drop 1 $ dropWhile (/= '.') returnType
-              else p
+            retType = pdReturnType <$> M.lookup proc allProcs
+            tName = case retType of
+              Just (SetOf (Composite qi)) -> qiName qi
+              Just (Single (Composite qi)) -> qiName qi
+              _ -> proc

        _ -> Nothing

    action :: Action
    action = iAction apiRequest

-    parseReadRequest :: Either ParseError ReadRequest
+    parseReadRequest :: Either ApiRequestError ReadRequest
    parseReadRequest = addFiltersOrdersRanges apiRequest <*>
      pRequestSelect rootName selStr
      where
@@ -78,20 +77,18 @@ readRequest maxRows allRels allProcs apiRequest  =
      _       -> allRels
      where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation

-treeRestrictRange :: Maybe Integer -> ReadRequest -> Either Text ReadRequest
+treeRestrictRange :: Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest
 treeRestrictRange maxRows_ request = pure $ nodeRestrictRange maxRows_ `fmap` request
  where
    nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
    nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)

-augumentRequestWithJoin :: Schema ->  [Relation] ->  ReadRequest -> Either Text ReadRequest
+augumentRequestWithJoin :: Schema ->  [Relation] ->  ReadRequest -> Either ApiRequestError ReadRequest
 augumentRequestWithJoin schema allRels request =
-  (first formatRelationError . addRelations schema allRels Nothing) request
+  addRelations schema allRels Nothing request
  >>= addJoinConditions schema
-  where
-    formatRelationError = ("could not find foreign keys between these entities, " <>)

-addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest
+addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
 addRelations schema allRelations parentNode (Node readNode@(query, (name, _, alias)) forest) =
  case parentNode of
    (Just (Node (Select{from=[parentNodeTable]}, (_, _, _)) _)) ->
@@ -100,8 +97,8 @@ addRelations schema allRelations parentNode (Node readNode@(query, (name, _, ali
        forest' = updateForest $ hush node'
        node' = Node <$> readNode' <*> pure forest
        readNode' = addRel readNode <$> rel
-        rel :: Either Text Relation
-        rel = note ("no relation between " <> parentNodeTable <> " and " <> name)
+        rel :: Either ApiRequestError Relation
+        rel = note (NoRelationBetween parentNodeTable name)
            $ findRelation schema name parentNodeTable

            where
@@ -153,10 +150,10 @@ addRelations schema allRelations parentNode (Node readNode@(query, (name, _, ali
        t = Table schema name True -- !!! TODO find another way to get the table from the query
        r = Relation t [] t [] Root Nothing Nothing Nothing
  where
-    updateForest :: Maybe ReadRequest -> Either Text [ReadRequest]
+    updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest]
    updateForest n = mapM (addRelations schema allRelations n) forest

-addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest
+addJoinConditions :: Schema -> ReadRequest -> Either ApiRequestError ReadRequest
 addJoinConditions schema (Node nn@(query, (n, r, a)) forest) =
  case r of
    Just Relation{relType=Root} -> Node nn  <$> updatedForest -- this is the root node
@@ -167,12 +164,12 @@ addJoinConditions schema (Node nn@(query, (n, r, a)) forest) =
      where
         query' = addCond query (getJoinConditions rel)
         qq = query'{from=tableName linkTable : from query'}
-    _ -> Left "unknown relation"
+    _ -> Left UnknownRelation
  where
    updatedForest = mapM (addJoinConditions schema) forest
    addCond query' con = query'{flt_=con ++ flt_ query'}

-addFiltersOrdersRanges :: ApiRequest -> Either ParseError (ReadRequest -> ReadRequest)
+addFiltersOrdersRanges :: ApiRequest -> Either ApiRequestError (ReadRequest -> ReadRequest)
 addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
    flip (foldr addFilter) <$> filters,
    flip (foldr addOrder) <$> orders,
@@ -183,7 +180,7 @@ addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
  of type (ReadRequest->ReadRequest) that are in (Either ParseError a) context
  -}
  where
-    filters :: Either ParseError [(Path, Filter)]
+    filters :: Either ApiRequestError [(Path, Filter)]
    filters = mapM pRequestFilter flts
      where
        action = iAction apiRequest
@@ -191,9 +188,9 @@ addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
          | action == ActionRead = iFilters apiRequest
          | action == ActionInvoke = iFilters apiRequest
          | otherwise = filter (( "." `isInfixOf` ) . fst) $ iFilters apiRequest -- there can be no filters on the root table whre we are doing insert/update
-    orders :: Either ParseError [(Path, [OrderTerm])]
+    orders :: Either ApiRequestError [(Path, [OrderTerm])]
    orders = mapM pRequestOrder $ iOrder apiRequest
-    ranges :: Either ParseError [(Path, NonnegRange)]
+    ranges :: Either ApiRequestError [(Path, NonnegRange)]
    ranges = mapM pRequestRange $ M.toList $ iRange apiRequest

 addFilterToNode :: Filter -> ReadRequest -> ReadRequest
@@ -247,13 +244,13 @@ toSourceRelation mt r@(Relation t _ ft _ _ rt _ _)
  | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceCTEName}) <$> rt}
  | otherwise = Nothing

-mutateRequest :: ApiRequest -> ReadRequest -> Either Response MutateRequest
-mutateRequest apiRequest readReq = mapLeft (errResponse status400) $
+mutateRequest :: ApiRequest -> [FieldName] -> Either Response MutateRequest
+mutateRequest apiRequest fldNames = mapLeft apiRequestError $
  case action of
    ActionCreate -> Right $ Insert rootTableName payload returnings
    ActionUpdate -> Update rootTableName <$> pure payload <*> filters <*> pure returnings
    ActionDelete -> Delete rootTableName <$> filters <*> pure returnings
-    _        -> Left "Unsupported HTTP verb"
+    _        -> Left UnsupportedVerb
  where
    action = iAction apiRequest
    payload = fromJust $ iPayload apiRequest
@@ -262,14 +259,14 @@ mutateRequest apiRequest readReq = mapLeft (errResponse status400) $
      case target of
        (TargetIdent (QualifiedIdentifier _ t) ) -> t
        _ -> undefined
-    fieldNames :: ReadRequest -> PreferRepresentation -> [FieldName]
-    fieldNames _ None = []
-    fieldNames (Node (sel, _) forest) _ =
-      map (fst . view _1) (select sel) ++ map colName fks
-      where
-        fks = concatMap (fromMaybe [] . f) forest
-        f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _)) _) = Just cols
-        f _ = Nothing
-    returnings = fieldNames readReq (iPreferRepresentation apiRequest) 
-    filters = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
+    returnings = if iPreferRepresentation apiRequest == None then [] else fldNames
+    filters = map snd <$> mapM pRequestFilter mutateFilters
      where mutateFilters = filter (not . ( "." `isInfixOf` ) . fst) $ iFilters apiRequest -- update/delete filters can be only on the root table
+
+fieldNames :: ReadRequest -> [FieldName]
+fieldNames (Node (sel, _) forest) =
+  map (fst . view _1) (select sel) ++ map colName fks
+  where
+    fks = concatMap (fromMaybe [] . f) forest
+    f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _)) _) = Just cols
+    f _ = Nothing
@@ -13,6 +13,7 @@ import qualified Hasql.Encoders                as HE
 import qualified Hasql.Query                   as H

 import           Control.Applicative
+import qualified Data.HashMap.Strict           as M
 import           Data.List                     (elemIndex)
 import           Data.Maybe                    (fromJust)
 import           Data.Text                     (split, strip,
@@ -96,12 +97,22 @@ decodeSynonyms cols =
    <*> HD.value HD.text <*> HD.value HD.text
    <*> HD.value HD.text <*> HD.value HD.text

-accessibleProcs :: H.Query Schema [(Text, ProcDescription)]
+accessibleProcs :: H.Query Schema (M.HashMap Text ProcDescription)
 accessibleProcs =
  H.statement sql (HE.value HE.text)
-    (map addName <$> HD.rowsList (ProcDescription <$> HD.value HD.text
-                                <*> (parseArgs <$> HD.value HD.text)
-                                <*> HD.value HD.text)) True
+    (M.fromList . map addName <$>
+      HD.rowsList (
+        ProcDescription <$> HD.value HD.text
+                        <*> (parseArgs <$> HD.value HD.text)
+                        <*> (parseRetType <$>
+                            HD.value HD.text <*>
+                            HD.value HD.text <*>
+                            HD.value HD.bool <*>
+                            HD.value HD.char)
+                        <*> (parseVolatility <$>
+                            HD.value HD.char)
+      )
+    ) True
 where
  addName :: ProcDescription -> (Text, ProcDescription)
  addName pd = (pdName pd, pd)
@@ -118,14 +129,37 @@ accessibleProcs =
       else Just $
         PgArg (dropAround (== '"') name) (strip typ) (T.null def)

+  parseRetType :: Text -> Text -> Bool -> Char -> RetType
+  parseRetType schema name isSetOf typ
+    | isSetOf   = SetOf pgType
+    | otherwise = Single pgType
+    where
+      qi = QualifiedIdentifier schema name
+      pgType = case typ of
+        'c' -> Composite qi
+        'p' -> Pseudo name
+        _   -> Scalar qi -- 'b'ase, 'd'omain, 'e'num, 'r'ange
+
+  parseVolatility :: Char -> ProcVolatility
+  parseVolatility 'i' = Immutable
+  parseVolatility 's' = Stable
+  parseVolatility 'v' = Volatile
+  parseVolatility _   = Volatile -- should not happen, but be pessimistic
+
  sql = [q|
-    SELECT p.proname as "proc_name",
-           pg_get_function_arguments(p.oid) as "args",
-           pg_get_function_result(p.oid) as "return_type"
-    FROM   pg_namespace n
-    JOIN   pg_proc p
-    ON     pronamespace = n.oid
-    WHERE  n.nspname = $1|]
+  SELECT p.proname as "proc_name",
+         pg_get_function_arguments(p.oid) as "args",
+         tn.nspname as "rettype_schema",
+         coalesce(comp.relname, t.typname) as "rettype_name",
+         p.proretset as "rettype_is_setof",
+         t.typtype as "rettype_typ",
+         p.provolatile
+  FROM pg_proc p
+    JOIN pg_namespace pn ON pn.oid = p.pronamespace
+    JOIN pg_type t ON t.oid = p.prorettype
+    JOIN pg_namespace tn ON tn.oid = t.typnamespace
+    LEFT JOIN pg_class comp ON comp.oid = t.typrelid
+  WHERE  pn.nspname = $1|]

 accessibleTables :: H.Query Schema [Table]
 accessibleTables =
@@ -606,7 +640,7 @@ allSynonyms cols =
                select case when match is not null then coalesce(match[8], match[7], match[4]) end
                from regexp_matches(
                    CONCAT('SELECT ', SPLIT_PART(vcu.view_definition, 'SELECT', 2)),
-                    CONCAT('SELECT.*?((',vcu.table_name,')|(\w+))\.(', vcu.column_name, ')(\s+AS\s+("([^"]+)"|([^, \n\t]+)))?.*?FROM.*?',vcu.table_schema,'\.(\2|',vcu.table_name,'\s+(as\s)?\3)'),
+                    CONCAT('SELECT.*?((',vcu.table_name,')|(\w+))\.(', vcu.column_name, ')(\s+AS\s+("([^"]+)"|([^, \n\t]+)))?.*?FROM.*?(',vcu.table_schema,'\.|)(\2|',vcu.table_name,'\s+(as\s)?\3)'),
                    'nsi'
                ) match
            ) as view_column_name
@@ -2,46 +2,55 @@
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}

-module PostgREST.Error (apiRequestErrResponse, pgErrResponse, errResponse, prettyUsageError, singularityError, formatGeneralError, formatParserError) where
+module PostgREST.Error (
+  apiRequestError
+, pgError
+, simpleError
+, singularityError
+, binaryFieldError
+, encodeError
+) where

 import           Protolude
 import           Data.Aeson                ((.=))
 import qualified Data.Aeson                as JSON
-import           Data.Text                 (replace, strip, unwords)
+import           Data.Text                 (unwords)
 import qualified Hasql.Pool                as P
 import qualified Hasql.Session             as H
 import qualified Network.HTTP.Types.Status as HT
 import           Network.Wai               (Response, responseLBS)
-import           PostgREST.ApiRequest      (toHeader, toMime, ContentType(..), ApiRequestError(..))
-import           Text.Parsec.Error
+import           PostgREST.Types

-apiRequestErrResponse :: ApiRequestError -> Response
-apiRequestErrResponse err =
-  case err of
-    ErrorActionInappropriate -> errResponse HT.status405 "Bad Request"
-    ErrorInvalidBody errorMessage -> errResponse HT.status400 $ toS errorMessage
-    ErrorInvalidRange -> errResponse HT.status416 "HTTP Range error"
+apiRequestError :: ApiRequestError -> Response
+apiRequestError err = errorResponse status 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

-errResponse :: HT.Status -> Text -> Response
-errResponse status message = jsonErrResponse status $ JSON.object ["message" .= message]
+simpleError :: HT.Status -> Text -> Response
+simpleError status message =
+  errorResponse status $ JSON.object ["message" .= message]

-jsonErrResponse :: HT.Status -> JSON.Value -> Response
-jsonErrResponse status message = responseLBS status [toHeader CTApplicationJSON] $ JSON.encode message
+errorResponse :: JSON.ToJSON a => HT.Status -> a -> Response
+errorResponse status e =
+  responseLBS status [toHeader CTApplicationJSON] $ encodeError e

-pgErrResponse :: Bool -> P.UsageError -> Response
-pgErrResponse authed 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 (JSON.encode e)
-
-prettyUsageError :: P.UsageError -> Text
-prettyUsageError (P.ConnectionError e) =
-  "Database connection error:\n" <> toS (fromMaybe "" e)
-prettyUsageError e = show $ JSON.encode e
+  responseLBS status hdrs (encodeError e)

 singularityError :: Integer -> Response
 singularityError numRows =
@@ -53,22 +62,40 @@ singularityError numRows =
        [ "Results contain", show numRows, "rows,"
        , toS (toMime CTSingularJSON), "requires 1 row"
        ]
-
-formatParserError :: ParseError -> Text
-formatParserError e = formatGeneralError message details
  where
-     message = show $ errorPos e
-     details = strip $ replace "\n" " " $ toS
-       $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
+    formatGeneralError :: Text -> Text -> Text
+    formatGeneralError message details = toS . JSON.encode $
+      JSON.object ["message" .= message, "details" .= details]

-formatGeneralError :: Text -> Text -> Text
-formatGeneralError message details = toS . JSON.encode $
-  JSON.object ["message" .= message, "details" .= details]
+
+binaryFieldError :: Response
+binaryFieldError =
+  simpleError HT.status406 (toS (toMime CTOctetStream) <>
+  " requested but a single column was not selected")
+
+encodeError :: JSON.ToJSON a => a -> LByteString
+encodeError = JSON.encode
+
+instance JSON.ToJSON ApiRequestError where
+  toJSON (ParseRequestError message details) = JSON.object [
+    "message" .= message, "details" .= details]
+  toJSON ActionInappropriate = JSON.object [
+    "message" .= ("Bad Request" :: Text)]
+  toJSON (InvalidBody errorMessage) = JSON.object [
+    "message" .= (toS errorMessage :: Text)]
+  toJSON InvalidRange = JSON.object [
+    "message" .= ("HTTP Range error" :: Text)]
+  toJSON UnknownRelation = JSON.object [
+    "message" .= ("Unknown relation" :: Text)]
+  toJSON (NoRelationBetween parent child) = JSON.object [
+    "message" .= ("Could not find foreign keys between these entities, No relation found between " <> parent <> " and " <> child :: Text)]
+  toJSON UnsupportedVerb = JSON.object [
+    "message" .= ("Unsupported HTTP verb" :: Text)]

 instance JSON.ToJSON P.UsageError where
  toJSON (P.ConnectionError e) = JSON.object [
    "code" .= ("" :: Text),
-    "message" .= ("Connection error" :: Text),
+    "message" .= ("Database connection error" :: Text),
    "details" .= (toS $ fromMaybe "" e :: Text)]
  toJSON (P.SessionError e) = JSON.toJSON e -- H.Error

@@ -1,5 +1,6 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}

 module PostgREST.Middleware where

@@ -14,11 +15,12 @@ import           Network.Wai.Middleware.Cors   (cors)
 import           Network.Wai.Middleware.Gzip   (def, gzip)
 import           Network.Wai.Middleware.Static (only, staticPolicy)

-import           PostgREST.ApiRequest          (ApiRequest(..), ContentType(..),
-                                                toHeader)
-import           PostgREST.Auth                (claimsToSQL, JWTAttempt(..))
+import           PostgREST.ApiRequest          (ApiRequest(..))
+import           PostgREST.Auth                (JWTAttempt(..))
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
-import           PostgREST.Error               (errResponse)
+import           PostgREST.Error               (simpleError)
+import           PostgREST.Types               (ContentType (..), toHeader)
+import           PostgREST.QueryBuilder        (pgFmtLit, unquoted, pgFmtEnvVar)

 import           Protolude                     hiding (concat, null)

@@ -29,16 +31,22 @@ runWithClaims conf eClaims app req =
  case eClaims of
    JWTExpired -> return $ unauthed "JWT expired"
    JWTInvalid -> return $ unauthed "JWT invalid"
-    JWTMissingSecret -> return $ errResponse status500 "Server lacks JWT secret"
+    JWTMissingSecret -> return $ simpleError status500 "Server lacks JWT secret"
    JWTClaims claims -> do
-      -- role claim defaults to anon if not specified in jwt
-      let setClaims = claimsToSQL (M.union claims (M.singleton "role" anon))
-      H.sql $ mconcat setClaims
+      H.sql $ toS.mconcat $ setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql
      mapM_ H.sql customReqCheck
      app req
+      where
+        headersSql = map (pgFmtEnvVar "request.header.") $ iHeaders req
+        cookiesSql = map (pgFmtEnvVar "request.cookie.") $ iCookies req
+        claimsSql = map (pgFmtEnvVar "request.jwt.claim.") [(c,unquoted v) | (c,v) <- M.toList claimsWithRole]
+        setRoleSql = maybeToList $
+          (\r -> "set local role " <> r <> ";") . toS . pgFmtLit . unquoted <$> M.lookup "role" claimsWithRole
+        -- role claim defaults to anon if not specified in jwt
+        claimsWithRole = M.union claims (M.singleton "role" anon)
+        anon = String . toS $ configAnonRole conf
+        customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf
  where
-    anon = String . toS $ configAnonRole conf
-    customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf
    unauthed message = responseLBS unauthorized401
      [ toHeader CTApplicationJSON
      , ( "WWW-Authenticate"
@@ -20,11 +20,10 @@ import           Protolude hiding              (concat, (&), Proxy, get, interca

 import           Data.Swagger

-import           PostgREST.ApiRequest        (ContentType(..), toMime)
+import           PostgREST.ApiRequest        (ContentType(..))
 import           PostgREST.Config            (prettyVersion)
-import           PostgREST.QueryBuilder      (operators)
 import           PostgREST.Types             (Table(..), Column(..), PgArg(..),
-                                              Proxy(..), ProcDescription(..))
+                                              Proxy(..), ProcDescription(..), toMime, Operator(..))

 makeMimeList :: [ContentType] -> MimeList
 makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs
@@ -73,7 +72,7 @@ makeOperatorPattern =
  intercalate "|"
  [ concat ["^", x, y, "[.]"] |
    x <- ["not[.]", ""],
-    y <- map fst operators ]
+    y <- map show [Equals ..] ]

 makeRowFilter :: Column -> Param
 makeRowFilter c =
@@ -237,7 +236,7 @@ makeRootPathItem = ("/", p)
  where
    getOp = (mempty :: Operation)
      & tags .~ Set.fromList ["/"]
-      & produces ?~ makeMimeList [CTOpenAPI]
+      & produces ?~ makeMimeList [CTOpenAPI, CTApplicationJSON]
      & at 200 ?~ "OK"
    pr = (mempty :: PathItem) & get ?~ getOp
    p = pr
@@ -2,37 +2,38 @@ module PostgREST.Parsers where

 import           Protolude                     hiding (try, intercalate)
 import           Control.Monad                ((>>))
-import           Data.Text                     (intercalate)
+import           Data.Foldable                (foldl1)
+import           Data.Text                     (intercalate, replace, strip)
 import           Data.List                     (init, last)
 import           Data.Tree
-import           PostgREST.QueryBuilder        (operators)
+import           Data.Either.Combinators       (mapLeft)
 import           PostgREST.Types
 import           Text.ParserCombinators.Parsec hiding (many, (<|>))
+import           Text.Read                    (read)
 import           PostgREST.RangeQuery      (NonnegRange,allRange)
+import           Text.Parsec.Error

-pRequestSelect :: Text -> Text -> Either ParseError ReadRequest
-pRequestSelect rootName selStr = 
-  parse (pReadRequest rootName) ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)
+pRequestSelect :: Text -> Text -> Either ApiRequestError ReadRequest
+pRequestSelect rootName selStr =
+  mapError $ parse (pReadRequest rootName) ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)

-pRequestFilter :: (Text, Text) -> Either ParseError (Path, Filter)
-pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
+pRequestFilter :: (Text, Text) -> Either ApiRequestError (Path, Filter)
+pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
  where
    treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
-    opVal = parse pOpValueExp ("failed to parse filter (" ++ toS v ++ ")") $ toS v
+    oper = parse pOperation ("failed to parse filter (" ++ toS v ++ ")") $ toS v
    path = fst <$> treePath
    fld = snd <$> treePath
-    op = fst <$> opVal
-    val = snd <$> opVal

-pRequestOrder :: (Text, Text) -> Either ParseError (Path, [OrderTerm])
-pRequestOrder (k, v) = (,) <$> path <*> ord'
+pRequestOrder :: (Text, Text) -> Either ApiRequestError (Path, [OrderTerm])
+pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord'
  where
    treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
    path = fst <$> treePath
    ord' = parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v

-pRequestRange :: (ByteString, NonnegRange) -> Either ParseError (Path, NonnegRange)
-pRequestRange (k, v) = (,) <$> path <*> pure v
+pRequestRange :: (ByteString, NonnegRange) -> Either ApiRequestError (Path, NonnegRange)
+pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v
  where
    treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
    path = fst <$> treePath
@@ -118,22 +119,29 @@ pSelect = lexeme $
    s <- pStar
    return ((s, Nothing), Nothing, Nothing)

-pOperator :: Parser Operator
-pOperator = toS <$> (pOp <?> "operator (eq, gt, ...)")
-  where pOp = foldl (<|>) empty $ map (try . string . toS . fst) operators
+pOperation :: Parser Operation
+pOperation = try ( string "not" *> pDelimiter *> (Operation True <$> pExpr)) <|> Operation False <$> pExpr
+  where
+    pExpr :: Parser (Operator, Operand)
+    pExpr =
+          ((,) <$> (read <$> foldl1 (<|>) (try . string . show <$> notInOps)) <*> (pDelimiter *> pVText))
+      <|> try (string (show In) *> pDelimiter *> ((,) <$> pure In <*> pVTextL))
+      <|> try (string (show NotIn) *> pDelimiter *> ((,) <$> pure NotIn <*> pVTextL))
+      <?> "operator (eq, gt, ...)"
+    notInOps = [Equals .. Contained]

-pValue :: Parser FValue
-pValue = VText <$> (toS <$> many anyChar)
+pVText :: Parser Operand
+pVText = VText . toS <$> many anyChar
+
+pVTextL :: Parser Operand
+pVTextL = VTextL <$> pLValue `sepBy1` char ','
+  where
+    pLValue :: Parser Text
+    pLValue = toS <$> (try (char '"' *> many (noneOf "\"") <* char '"' <* notFollowedBy (noneOf ",") ) <|> many (noneOf ","))

 pDelimiter :: Parser Char
 pDelimiter = char '.' <?> "delimiter (.)"

-pOperatiorWithNegation :: Parser Operator
-pOperatiorWithNegation = try ( (<>) <$> ( toS <$> string "not." ) <*>  pOperator) <|> pOperator
-
-pOpValueExp :: Parser (Operator, FValue)
-pOpValueExp = (,) <$> pOperatiorWithNegation <*> (pDelimiter *> pValue)
-
 pOrder :: Parser [OrderTerm]
 pOrder = lexeme pOrderTerm `sepBy` char ','

@@ -152,3 +160,13 @@ pOrderTerm =
    return $ OrderTerm c d nls
  )
  <|> OrderTerm <$> pField <*> pure Nothing <*> pure Nothing
+
+mapError :: Either ParseError a -> Either ApiRequestError a
+mapError = mapLeft translateError
+  where
+    translateError e =
+      ParseRequestError message details
+      where
+        message = show $ errorPos e
+        details = strip $ replace "\n" " " $ toS
+           $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
@@ -16,7 +16,6 @@ module PostgREST.QueryBuilder (
  , createReadStatement
  , createWriteStatement
  , getJoinConditions
-  , operators
  , pgFmtIdent
  , pgFmtLit
  , requestToQuery
@@ -24,6 +23,7 @@ module PostgREST.QueryBuilder (
  , sourceCTEName
  , unquoted
  , ResultsWithCount
+  , pgFmtEnvVar
  ) where

 import qualified Hasql.Query             as H
@@ -35,13 +35,13 @@ import qualified Data.Aeson              as JSON
 import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset, allRange)
 import           Data.Functor.Contravariant (contramap)
 import qualified Data.HashMap.Strict     as HM
-import           Data.Text               (intercalate, unwords, replace, isInfixOf, toLower, split)
+import           Data.Maybe
+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 qualified Data.Vector as V
 import           PostgREST.Types
-import qualified Data.Map as M
 import           Text.InterpolatedString.Perl6 (qc)
 import qualified Data.ByteString.Char8   as BS
 import           Data.Scientific         ( FPFormat (..)
@@ -86,9 +86,9 @@ encodeUniformObjs :: HE.Params PayloadJSON
 encodeUniformObjs =
  contramap (JSON.Array . V.map JSON.Object . unPayloadJSON) (HE.value HE.json)

-createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
+createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->
                       H.Query () ResultsWithCount
-createReadStatement selectQuery countQuery isSingle countTotal asCsv =
+createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =
  unicodeStatement sql HE.unit decodeStandard False
 where
  sql = [qc|
@@ -104,6 +104,7 @@ createReadStatement selectQuery countQuery isSingle countTotal asCsv =
  bodyF
    | asCsv = asCsvF
    | isSingle = asJsonSingleF
+    | isJust binaryField = asBinaryF $ fromJust binaryField
    | otherwise = asJsonF

 createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
@@ -179,25 +180,6 @@ callProc qi params selectQuery countQuery _ countTotal isSingle paramsAsJson =
     | isSingle = asJsonSingleF
     | otherwise = asJsonF

-operators :: [(Text, SqlFragment)]
-operators = [
-  ("eq", "="),
-  ("gte", ">="), -- has to be before gt (parsers)
-  ("gt", ">"),
-  ("lte", "<="), -- has to be before lt (parsers)
-  ("lt", "<"),
-  ("neq", "<>"),
-  ("like", "like"),
-  ("ilike", "ilike"),
-  ("in", "in"),
-  ("notin", "not in"),
-  ("isnot", "is not"), -- has to be before is (parsers)
-  ("is", "is"),
-  ("@@", "@@"),
-  ("@>", "@>"),
-  ("<@", "<@")
-  ]
-
 pgFmtIdent :: SqlFragment -> SqlFragment
 pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\""

@@ -216,31 +198,27 @@ requestToCountQuery schema (DbRead (Node (Select _ _ conditions _ _, (mainTbl, _
 unwords [
   "SELECT pg_catalog.count(*)",
   "FROM ", fromQi qi,
-   ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi) localConditions )) `emptyOnNull` localConditions
+   ("WHERE " <> intercalate " AND " ( map (pgFmtFilter qi) localConditions )) `emptyOnNull` localConditions
   ]
 where
-   qi = if mainTbl == sourceCTEName
-     then QualifiedIdentifier "" mainTbl
-     else QualifiedIdentifier schema mainTbl
-   fn Filter{value=VText _} = True
-   fn Filter{value=VForeignKey _ _} = False
+   qi = removeSourceCTESchema schema mainTbl
+   fn Filter{operation=Operation{expr=(_, VText _)}} = True
+   fn Filter{operation=Operation{expr=(_, VTextL _)}} = True
+   fn Filter{operation=Operation{expr=(_, VForeignKey _ _)}} = False
   localConditions = filter fn conditions

 requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery
 requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions ord range, (nodeName, maybeRelation, _)) forest)) =
  query
  where
-    -- TODO! the following helper functions are just to remove the "schema" part when the table is "source" which is the name
-    -- of our WITH query part
    mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation)
-    tblSchema tbl = if tbl == sourceCTEName then "" else schema
-    qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl
-    toQi t = QualifiedIdentifier (tblSchema t) t
+    qi = removeSourceCTESchema schema mainTbl
+    toQi = removeSourceCTESchema schema
    query = unwords [
      "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
      "FROM ", intercalate ", " (map (fromQi . toQi) tbls),
      unwords joins,
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+      ("WHERE " <> intercalate " AND " ( map (pgFmtFilter qi ) conditions )) `emptyOnNull` conditions,
      orderF (fromMaybe [] ord),
      if isParent then "" else limitF range
      ]
@@ -269,11 +247,11 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions
      where
        node_name = fromMaybe name alias
        local_table_name = table <> "_" <> node_name
-        replaceTableName localTableName (Filter a b (VForeignKey (QualifiedIdentifier "" _) c)) = Filter a b (VForeignKey (QualifiedIdentifier "" localTableName) c)
+        replaceTableName localTableName (Filter a (Operation b (c, VForeignKey (QualifiedIdentifier "" _) d))) = Filter a (Operation b (c, VForeignKey (QualifiedIdentifier "" localTableName) d))
        replaceTableName _ x = x
        sel = "row_to_json(" <> pgFmtIdent local_table_name <> ".*) AS " <> pgFmtIdent node_name
        joi = " LEFT OUTER JOIN ( " <> subquery <> " ) AS " <> pgFmtIdent local_table_name  <>
-              " ON " <> intercalate " AND " ( map (pgFmtCondition qi . replaceTableName local_table_name) (getJoinConditions r) )
+              " ON " <> intercalate " AND " ( map (pgFmtFilter qi . replaceTableName local_table_name) (getJoinConditions r) )
          where subquery = requestToQuery schema True (DbRead (Node n forst))
    getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (j,sel:s)
      where
@@ -298,7 +276,7 @@ requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON rows) returnings)
          if T.null colsString
            then if V.null rows then ["SELECT null WHERE false"] else ["DEFAULT VALUES"]
            else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"]
-        ret = if null returnings 
+        ret = if null returnings
                  then ""
                  else unwords [" RETURNING ", intercalate ", " (map (pgFmtColumn qi) returnings)]
 requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) conditions returnings)) =
@@ -309,7 +287,7 @@ requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) conditions
      unwords [
        "UPDATE ", fromQi qi,
        " SET " <> intercalate "," assignments <> " ",
-        ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+        ("WHERE " <> intercalate " AND " ( map (pgFmtFilter qi ) conditions )) `emptyOnNull` conditions,
        ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnNull` returnings
        ]
    Nothing -> undefined
@@ -321,13 +299,16 @@ requestToQuery schema _ (DbMutate (Delete mainTbl conditions returnings)) =
    qi = QualifiedIdentifier schema mainTbl
    query = unwords [
      "DELETE FROM ", fromQi qi,
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+      ("WHERE " <> intercalate " AND " ( map (pgFmtFilter qi ) conditions )) `emptyOnNull` conditions,
      ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnNull` returnings
      ]

 sourceCTEName :: SqlFragment
 sourceCTEName = "pg_source"

+removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
+removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl
+
 unquoted :: JSON.Value -> Text
 unquoted (JSON.String t) = t
 unquoted (JSON.Number n) =
@@ -356,6 +337,9 @@ asJsonF = "coalesce(array_to_json(array_agg(row_to_json(_postgrest_t))), '[]')::
 asJsonSingleF :: SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
 asJsonSingleF = "coalesce(string_agg(row_to_json(_postgrest_t)::text, ','), '')::character varying "

+asBinaryF :: FieldName -> SqlFragment
+asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
+
 locationF :: [Text] -> SqlFragment
 locationF pKeys =
    "(" <>
@@ -395,7 +379,7 @@ getJoinConditions (Relation t cols ft fcs typ lt lc1 lc2) =
    ftN = tableName ft
    ltN = fromMaybe "" (tableName <$> lt)
    toFilter :: Text -> Text -> Column -> Column -> Filter
-    toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))
+    toFilter tb ftb c fc = Filter (colName c, Nothing) (Operation False (Equals, VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}})))

 unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Query a b
 unicodeStatement = H.statement . T.encodeUtf8
@@ -411,11 +395,6 @@ insertableValueWithType :: Text -> JSON.Value -> SqlFragment
 insertableValueWithType t v =
  pgFmtLit (unquoted v) <> "::" <> t

-whiteList :: Text -> SqlFragment
-whiteList val = fromMaybe
-  (toS (pgFmtLit val) <> "::unknown ")
-  (find ((==) . toLower $ val) ["null","true","false"])
-
 pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
 pgFmtColumn table "*" = fromQi table <> ".*"
 pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
@@ -427,45 +406,40 @@ pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment
 pgFmtSelectItem table (f@(_, jp), Nothing, alias) = pgFmtField table f <> pgFmtAs jp alias
 pgFmtSelectItem table (f@(_, jp), Just cast, alias) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs jp alias

-pgFmtCondition :: QualifiedIdentifier -> Filter -> SqlFragment
-pgFmtCondition table (Filter (col,jp) ops val) =
-  notOp <> " " <> sqlCol  <> " " <> pgFmtOperator opCode <> " " <>
-    if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
+pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment
+pgFmtFilter table (Filter fld (Operation hasNot_ ex@(op, operand))) = notOp <> " " <> case operand of
+  VForeignKey fQi (ForeignKey Column{colTable=Table{tableName=fTableName}, colName=fColName}) ->
+    pgFmtField fQi fld <> " " <> opToSqlFragment op <> " " <> pgFmtColumn (removeSourceCTESchema (qiSchema fQi) fTableName) fColName
+  _ -> pgFmtField table fld <> " " <> pgFmtExpr ex
  where
-    headPredicate:rest = split (=='.') ops
-    hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
-    opCode      = hasNot (headDef "eq" rest) headPredicate
-    notOp       = hasNot headPredicate ""
-    sqlCol = case val of
-      VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
-      VForeignKey qi _ -> pgFmtColumn qi col
-    sqlValue = valToStr val
-    getInner v = case v of
-      VText s -> s
-      _      -> ""
-    valToStr v = case v of
-      VText s -> pgFmtValue opCode s
-      VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc
-        where qi = QualifiedIdentifier (if ft == sourceCTEName then "" else s) ft
-      _ -> ""
+    notOp = if hasNot_ then "NOT" else ""

-pgFmtValue :: Text -> Text -> SqlFragment
-pgFmtValue opCode val =
- case opCode of
-   "like" -> unknownLiteral $ T.map star val
-   "ilike" -> unknownLiteral $ T.map star val
-   "in" -> "(" <> intercalate ", " (map unknownLiteral $ split (==',') val) <> ") "
-   "notin" -> "(" <> intercalate ", " (map unknownLiteral $ split (==',') val) <> ") "
-   "@@" -> "to_tsquery(" <> unknownLiteral val <> ") "
-   _    -> unknownLiteral val
+pgFmtExpr :: (Operator, Operand) -> SqlFragment
+pgFmtExpr ex =
+ case ex of
+   (Like, VText val)    -> opToSqlFragment Like <> " " <> unknownLiteral (T.map star val)
+   (ILike, VText val)   -> opToSqlFragment ILike <> " " <> unknownLiteral (T.map star val)
+   (TSearch, VText val) -> opToSqlFragment TSearch <> " " <> "to_tsquery(" <> unknownLiteral val <> ") "
+   (Is, VText val)      -> opToSqlFragment Is <> " " <> whiteList val
+   (In, VTextL vals)    -> exprForIn vals
+   (NotIn, VTextL vals) -> opToSqlFragment NotIn <> " " <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "
+   (op, VText val)      -> opToSqlFragment op <> " " <> unknownLiteral val
+   _ -> "" -- should not happen, all possible combinations are defined in Parsers
 where
   star c = if c == '*' then '%' else c
   unknownLiteral = (<> "::unknown ") . pgFmtLit
-
-pgFmtOperator :: Text -> SqlFragment
-pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
-  where
-    operatorsMap = M.fromList operators
+   whiteList :: Text -> SqlFragment
+   whiteList v = fromMaybe
+     (toS (pgFmtLit v) <> "::unknown ")
+     (find ((==) . toLower $ v) ["null","true","false"])
+   exprForIn :: [Text] -> SqlFragment
+   exprForIn vals =
+    let emptyValForIn = "= any('{}') " in
+    case T.null <$> headMay vals of
+      Just isNull -> if isNull && length vals == 1
+                        then emptyValForIn
+                        else opToSqlFragment In <> " " <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "
+      Nothing -> emptyValForIn

 pgFmtJsonPath :: Maybe JsonPath -> SqlFragment
 pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
@@ -479,5 +453,9 @@ pgFmtAs (Just xx) Nothing = case lastMay xx of
  Nothing -> ""
 pgFmtAs _ (Just alias) = " AS " <> pgFmtIdent alias

+pgFmtEnvVar :: Text -> (Text, Text) -> SqlFragment
+pgFmtEnvVar prefix (k, v) =
+  "set local " <> pgFmtIdent (prefix <> k) <> " = " <> pgFmtLit v <> ";"
+
 trimNullChars :: Text -> Text
 trimNullChars = T.takeWhile (/= '\x0')
@@ -1,18 +1,35 @@
 module PostgREST.Types where
 import           Protolude
 import qualified GHC.Show
+import qualified GHC.Read
 import           Data.Aeson
 import qualified Data.ByteString.Lazy as BL
+import           Data.HashMap.Strict  as M
 import           Data.Tree
 import qualified Data.Vector          as V
 import           PostgREST.RangeQuery (NonnegRange)
+import           Network.HTTP.Types.Header (hContentType, Header)
+
+-- | Enumeration of currently supported response content types
+data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI
+                 | CTSingularJSON | CTOctetStream
+                 | CTAny | CTOther ByteString deriving Eq
+
+data ApiRequestError = ActionInappropriate
+                     | InvalidBody ByteString
+                     | InvalidRange
+                     | ParseRequestError Text Text
+                     | UnknownRelation
+                     | NoRelationBetween Text Text
+                     | UnsupportedVerb
+                     deriving (Show, Eq)

 data DbStructure = DbStructure {
  dbTables      :: [Table]
 , dbColumns     :: [Column]
 , dbRelations   :: [Relation]
 , dbPrimaryKeys :: [PrimaryKey]
-, dbProcs       :: [(Text,ProcDescription)]
+, dbProcs       :: M.HashMap Text ProcDescription
 } deriving (Show, Eq)

 data PgArg = PgArg {
@@ -21,10 +38,18 @@ data PgArg = PgArg {
 , pgaReq  :: Bool
 } deriving (Show, Eq)

+data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier | Pseudo Text deriving (Eq, Show)
+
+data RetType = Single PgType | SetOf PgType deriving (Eq, Show)
+
+data ProcVolatility = Volatile | Stable | Immutable
+  deriving (Eq, Show)
+
 data ProcDescription = ProcDescription {
  pdName       :: Text
 , pdArgs       :: [PgArg]
-, pdReturnType :: Text
+, pdReturnType :: RetType
+, pdVolatility :: ProcVolatility
 } deriving (Show, Eq)

 type Schema = Text
@@ -39,7 +64,7 @@ data Table = Table {
 , tableInsertable :: Bool
 } deriving (Show, Ord)

-data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
+newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)

 data Column =
    Column {
@@ -54,9 +79,7 @@ data Column =
    , colDefault   :: Maybe Text
    , colEnum      :: [Text]
    , colFK        :: Maybe ForeignKey
-    }
-  | Star { colTable :: Table }
-  deriving (Show, Ord)
+    } deriving (Show, Ord)

 type Synonym = (Column,Column)

@@ -114,8 +137,66 @@ data Proxy = Proxy {
 , proxyPath       :: Text
 } deriving (Show, Eq)

-type Operator = Text
-data FValue = VText Text | VForeignKey QualifiedIdentifier ForeignKey deriving (Show, Eq)
+data Operator = Equals | Gte | Gt | Lte | Lt | Neq | Like | ILike | Is | IsNot |
+                TSearch | Contains | Contained | In | NotIn deriving (Eq, Enum)
+
+instance Show Operator where
+  show op =  case op of
+    Equals -> "eq"
+    Gte -> "gte"
+    Gt -> "gt"
+    Lte -> "lte"
+    Lt -> "lt"
+    Neq -> "neq"
+    Like -> "like"
+    ILike -> "ilike"
+    In -> "in"
+    NotIn -> "notin"
+    IsNot -> "isnot"
+    Is -> "is"
+    TSearch -> "@@"
+    Contains -> "@>"
+    Contained -> "<@"
+
+instance Read Operator where
+  readsPrec _ op =  case op of
+    "eq" -> [(Equals, "")]
+    "gte" -> [(Gte, "")]
+    "gt" -> [(Gt, "")]
+    "lte" -> [(Lte, "")]
+    "lt" -> [(Lt, "")]
+    "neq" -> [(Neq, "")]
+    "like" -> [(Like, "")]
+    "ilike" -> [(ILike, "")]
+    "in" -> [(In, "")]
+    "notin" -> [(NotIn, "")]
+    "isnot" -> [(IsNot, "")]
+    "is" -> [(Is, "")]
+    "@@" -> [(TSearch, "")]
+    "@>" -> [(Contains, "")]
+    "<@" -> [(Contained, "")]
+    _ -> []
+
+opToSqlFragment :: Operator -> SqlFragment
+opToSqlFragment op = case op of
+  Equals -> "="
+  Gte -> ">="
+  Gt -> ">"
+  Lte -> "<="
+  Lt -> "<"
+  Neq -> "<>"
+  Like -> "LIKE"
+  ILike -> "ILIKE"
+  In -> "IN"
+  NotIn -> "NOT IN"
+  IsNot -> "IS NOT"
+  Is -> "IS"
+  TSearch -> "@@"
+  Contains -> "@>"
+  Contained -> "<@"
+
+data Operation = Operation{ hasNot::Bool, expr::(Operator, Operand) } deriving (Eq, Show)
+data Operand = VText Text | VTextL [Text] | VForeignKey QualifiedIdentifier ForeignKey deriving (Show, Eq)
 type FieldName = Text
 type JsonPath = [Text]
 type Field = (FieldName, Maybe JsonPath)
@@ -128,13 +209,12 @@ data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter
 data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON, returning::[FieldName] }
                 | Delete { in_::TableName, where_::[Filter], returning::[FieldName] }
                 | Update { in_::TableName, qPayload::PayloadJSON, where_::[Filter], returning::[FieldName] } deriving (Show, Eq)
-data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
+data Filter = Filter { field::Field, operation::Operation } deriving (Show, Eq)
 type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
 type ReadRequest = Tree ReadNode
 type MutateRequest = MutateQuery
 data DbRequest = DbRead ReadRequest | DbMutate MutateRequest

-
 instance ToJSON Column where
  toJSON c = object [
      "schema"    .= tableSchema t
@@ -171,4 +251,17 @@ instance Eq Table where

 instance Eq Column where
  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
-  _ == _ = False
+
+-- | 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
@@ -1,8 +1,7 @@
-resolver: lts-7.4
+resolver: lts-8.5
 extra-deps:
  - Ranged-sets-0.3.0
  - hasql-pool-0.4.1
-  - hasql-transaction-0.5
 ghc-options:
  postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints
 nix:
@@ -18,44 +18,40 @@ spec = 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` ResponseMatcher {
-        matchBody = Just [json| {
+    get "/authors_only" `shouldRespondWith` [json| {
          "hint":null,
          "details":null,
          "code":"42501",
          "message":"permission denied for relation authors_only"} |]
-      , matchStatus = 401
+      { matchStatus = 401
      , matchHeaders = ["WWW-Authenticate" <:> "Bearer"]
      }

  it "denies access to tables that postgrest_test_author does not own" $
    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" in
    request methodGet "/private_table" [auth] ""
-      `shouldRespondWith` ResponseMatcher {
-        matchBody = Just [json| {
+      `shouldRespondWith` [json| {
          "hint":null,
          "details":null,
          "code":"42501",
          "message":"permission denied for relation private_table"} |]
-      , matchStatus = 403
+      { matchStatus = 403
      , matchHeaders = []
      }

  it "returns jwt functions as jwt tokens" $
    request methodPost "/rpc/login" [single]
      [json| { "id": "jdoe", "pass": "1234" } |]
-      `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xuYW1lIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.P2G9EVSVI22MWxXWFuhEYd9BZerLS1WDlqzdqplM15s"} |]
-        , matchStatus = 200
-        , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
+      `shouldRespondWith` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xuYW1lIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.P2G9EVSVI22MWxXWFuhEYd9BZerLS1WDlqzdqplM15s"} |]
+        { matchStatus = 200
+        , matchHeaders = [matchContentTypeJson]
        }

  it "sql functions can encode custom and standard claims" $
    request methodPost  "/rpc/jwt_test" [single] "{}"
-      `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpc3MiOiJqb2UiLCJzdWIiOiJmdW4iLCJhdWQiOiJldmVyeW9uZSIsImV4cCI6MTMwMDgxOTM4MCwibmJmIjoxMzAwODE5MzgwLCJpYXQiOjEzMDA4MTkzODAsImp0aSI6ImZvbyIsInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdCIsImh0dHA6Ly9wb3N0Z3Jlc3QuY29tL2ZvbyI6dHJ1ZX0.IHF16ZSU6XTbOnUWO8CCpUn2fJwt8P00rlYVyXQjpWc"} |]
-        , matchStatus = 200
-        , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
+      `shouldRespondWith` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpc3MiOiJqb2UiLCJzdWIiOiJmdW4iLCJhdWQiOiJldmVyeW9uZSIsImV4cCI6MTMwMDgxOTM4MCwibmJmIjoxMzAwODE5MzgwLCJpYXQiOjEzMDA4MTkzODAsImp0aSI6ImZvbyIsInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdCIsImh0dHA6Ly9wb3N0Z3Jlc3QuY29tL2ZvbyI6dHJ1ZX0.IHF16ZSU6XTbOnUWO8CCpUn2fJwt8P00rlYVyXQjpWc"} |]
+        { matchStatus = 200
+        , matchHeaders = [matchContentTypeJson]
        }

  it "sql functions can read custom and standard claims variables" $ do
@@ -82,9 +78,8 @@ spec = describe "authorization" $ do
  it "fails with an expired token" $ do
    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjE0NDY2NzgxNDksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.enk_qZ_u6gZsXY4R8bREKB_HNExRpM0lIWSLktk9JJQ"
    request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` ResponseMatcher {
-          matchBody = Nothing
-        , matchStatus = 401
+      `shouldRespondWith` [json| {"message":"JWT expired"} |]
+        { matchStatus = 401
        , matchHeaders = [
            "WWW-Authenticate" <:>
            "Bearer error=\"invalid_token\", error_description=\"JWT expired\""
@@ -94,9 +89,8 @@ spec = describe "authorization" $ do
  it "hides tables from users with invalid JWT" $ do
    let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"
    request methodGet "/authors_only" [auth] ""
-      `shouldRespondWith` ResponseMatcher {
-          matchBody = Nothing
-        , matchStatus = 401
+      `shouldRespondWith` [json| {"message":"JWT invalid"} |]
+        { matchStatus = 401
        , matchHeaders = [
            "WWW-Authenticate" <:>
            "Bearer error=\"invalid_token\", error_description=\"JWT invalid\""
@@ -126,9 +120,8 @@ spec = describe "authorization" $ do
      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6MX0.mI2HNoOum6xM3sc4oHLxU4yLv-_WV5W1kqBfY_wEvLw" in
      request methodPost "/rpc/get_current_user" [auth]
        [json| {} |]
-         `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|"postgrest_test_author"|]
-          , matchStatus = 200
+         `shouldRespondWith` [str|"postgrest_test_author"|]
+          { matchStatus = 200
          , matchHeaders = []
          }

@@ -136,9 +129,8 @@ spec = describe "authorization" $ do
      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Mn0.W7jLsG-zswM91AJkCvZeIMHrnz7_6ceY2jnscVl3Yhk" in
      request methodPost "/rpc/get_current_user" [auth]
        [json| {} |]
-         `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|"postgrest_test_default_role"|]
-          , matchStatus = 200
+         `shouldRespondWith` [str|"postgrest_test_default_role"|]
+          { matchStatus = 200
          , matchHeaders = []
          }

@@ -146,8 +138,7 @@ spec = describe "authorization" $ do
      let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6M30.15Gy8PezQhJIaHYDJVLa-Gmz9T3sJnW66EKAYIsXc7c" in
      request methodPost "/rpc/get_current_user" [auth]
        [json| {} |]
-         `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|{"hint":"Please contact administrator","details":null,"code":"P0001","message":"Disabled ID --> 3"}|]
-          , matchStatus = 400
+         `shouldRespondWith` [str|{"hint":"Please contact administrator","details":null,"code":"P0001","message":"Disabled ID --> 3"}|]
+          { matchStatus = 400
          , matchHeaders = []
          }
@@ -24,14 +24,13 @@ spec =
    it "should not raise 'transaction in progress' error" $
      raceTest 10 $
        get "/fakefake"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json|
+          `shouldRespondWith` [json|
              { "hint": null,
                "details":null,
                "code":"42P01",
                "message":"relation \"test.fakefake\" does not exist"
              } |]
-          , matchStatus  = 404
+          { matchStatus  = 404
          , matchHeaders = []
          }

@@ -15,24 +15,21 @@ spec =
    context "existing record" $ do
      it "succeeds with 204 and deletion count" $
        request methodDelete "/items?id=eq.1" [] ""
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Nothing
-          , matchStatus  = 204
+          `shouldRespondWith` ""
+          { matchStatus  = 204
          , matchHeaders = ["Content-Range" <:> "*/*"]
          }

      it "returns the deleted item and count if requested" $
        request methodDelete "/items?id=eq.2" [("Prefer", "return=representation"), ("Prefer", "count=exact")] ""
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":2}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [str|[{"id":2}]|]
+          { matchStatus  = 200
          , matchHeaders = ["Content-Range" <:> "*/1"]
          }
      it "returns the deleted item and shapes the response" $
        request methodDelete "/complex_items?id=eq.2&select=id,name" [("Prefer", "return=representation")] ""
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":2,"name":"Two"}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [str|[{"id":2,"name":"Two"}]|]
+          { matchStatus  = 200
          , matchHeaders = ["Content-Range" <:> "*/*"]
          }
      it "can rename and cast the selected columns" $
@@ -40,18 +37,16 @@ spec =
          `shouldRespondWith` [str|[{"ciId":"3","ciName":"Three"}]|]
      it "can embed (parent) entities" $
        request methodDelete "/tasks?id=eq.8&select=id,name,project{id}" [("Prefer", "return=representation")] ""
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [str|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]
+          { matchStatus  = 200
          , matchHeaders = ["Content-Range" <:> "*/*"]
          }

      it "actually clears items ouf the db" $ do
        _ <- request methodDelete "/items?id=lt.15" [] ""
        get "/items"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":15}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [str|[{"id":15}]|]
+          { matchStatus  = 200
          , matchHeaders = ["Content-Range" <:> "0-0/*"]
          }

@@ -59,9 +54,8 @@ spec =
      it "includes [] body if return=rep" $
        request methodDelete "/items?id=eq.101"
          [("Prefer", "return=representation")] ""
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "[]"
-          , matchStatus  = 200
+          `shouldRespondWith` "[]"
+          { matchStatus  = 200
          , matchHeaders = ["Content-Range" <:> "*/*"]
          }

@@ -3,6 +3,7 @@ module Feature.InsertSpec where
 import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
+import Test.Hspec.Wai.Matcher (bodyEquals)
 import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))

 import SpecHelper
@@ -43,31 +44,29 @@ spec = do
            "integer": 14, "double": 3.14159, "varchar": "testing!"
          , "boolean": false, "date": "1900-01-01", "money": "$3.99"
          , "enum": "foo"
-          }] |] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"integer":14,"varchar":"testing!"}]|]
-          , matchStatus  = 201
-          , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]
+          }] |] `shouldRespondWith` [str|[{"integer":14,"varchar":"testing!"}]|]
+          { matchStatus  = 201
+          , matchHeaders = [matchContentTypeJson]
          }

    context "requesting full representation" $ do
      it "includes related data after insert" $
        request methodPost "/projects?select=id,name,clients{id,name}"
                [("Prefer", "return=representation"), ("Prefer", "count=exact")]
-          [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}]|]
-          , matchStatus  = 201
-          , matchHeaders = [ "Content-Type" <:> "application/json; charset=utf-8"
+          [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` [str|[{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}]|]
+          { matchStatus  = 201
+          , matchHeaders = [ matchContentTypeJson
                           , "Location" <:> "/projects?id=eq.6"
                           , "Content-Range" <:> "*/1" ]
          }

      it "can rename and cast the selected columns" $
        request methodPost "/projects?select=pId:id::text,pName:name,cId:client_id::text"
-                [("Prefer", "return=representation")] 
-          [str|{"id":7,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"pId":"7","pName":"New Project","cId":"2"}]|]
-          , matchStatus  = 201
-          , matchHeaders = [ "Content-Type" <:> "application/json; charset=utf-8"
+                [("Prefer", "return=representation")]
+          [str|{"id":7,"name":"New Project","client_id":2}|] `shouldRespondWith`
+          [str|[{"pId":"7","pName":"New Project","cId":"2"}]|]
+          { matchStatus  = 201
+          , matchHeaders = [ matchContentTypeJson
                           , "Location" <:> "/projects?id=eq.7"
                           , "Content-Range" <:> "*/*" ]
          }
@@ -201,9 +200,8 @@ spec = do
        request methodPost "/json"
                     [("Prefer", "return=representation")]
                     inserted
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"data":{"foo":"bar"}}]|]
-          , matchStatus  = 201
+          `shouldRespondWith` [str|[{"data":{"foo":"bar"}}]|]
+          { matchStatus  = 201
          , matchHeaders = ["Location" <:> location]
          }

@@ -213,39 +211,35 @@ spec = do
        request methodPost "/json"
                     [("Prefer", "return=representation")]
                     inserted
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"data":[1,2,3]}]|]
-          , matchStatus  = 201
+          `shouldRespondWith` [str|[{"data":[1,2,3]}]|]
+          { matchStatus  = 201
          , matchHeaders = ["Location" <:> location]
          }

    context "empty object" $
      it "successfully populates table with all-default columns" $
-        post "/items" "{}" `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just ""
-          , matchStatus  = 201
+        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")]
-          [json| {"article_id": 2, "user_id": 1} |] `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"article_id":2,"user_id":1}]|]
-          , matchStatus  = 201
+          [json| {"article_id": 2, "user_id": 1} |] `shouldRespondWith` [str|[{"article_id":2,"user_id":1}]|]
+          { matchStatus  = 201
          , matchHeaders = []
          }
      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` ResponseMatcher {
-            matchBody    = Just [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
-          , matchStatus  = 401
+          [json| {"article_id": 2, "user_id": 2} |] `shouldRespondWith`
+          [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` ResponseMatcher {
-            matchBody    = Just [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
-          , matchStatus  = 401
+          [json| {"article_id": 3, "user_id": 1} |] `shouldRespondWith` [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]
+          { matchStatus  = 401
          , matchHeaders = []
          }

@@ -259,11 +253,10 @@ spec = do
            |12,0.1,a string,true,1929-10-01,12,bar
            |]
        request methodPost "/menagerie" [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] inserted
-
-           `shouldRespondWith` ResponseMatcher {
-             matchBody    = Just inserted
-           , matchStatus  = 201
+           `shouldRespondWith` ResponseMatcher
+           { matchStatus  = 201
           , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+           , matchBody = bodyEquals inserted
           }

    context "requesting full representation" $ do
@@ -271,9 +264,8 @@ spec = do
        request methodPost "/no_pk"
                     [("Content-Type", "text/csv"), ("Accept", "text/csv"),  ("Prefer", "return=representation")]
                     "a,b\nbar,baz"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "a,b\nbar,baz"
-          , matchStatus  = 201
+          `shouldRespondWith` "a,b\nbar,baz"
+          { matchStatus  = 201
          , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
                            "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"]
          }
@@ -282,9 +274,8 @@ spec = do
        request methodPost "/no_pk"
                     [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
                     "a,b\nNULL,foo"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "a,b\n,foo"
-          , matchStatus  = 201
+          `shouldRespondWith` "a,b\n,foo"
+          { matchStatus  = 201
          , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
                            "Location" <:> "/no_pk?a=is.null&b=eq.foo"]
          }
@@ -293,9 +284,8 @@ spec = do
        request methodPost "/projects?select=id"
                     [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")]
                     "id,name,client_id\n8,Xenix,1\n9,Windows NT,1"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "id\n8\n9"
-          , matchStatus  = 201
+          `shouldRespondWith` "id\n8\n9"
+          { matchStatus  = 201
          , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8",
                            "Content-Range" <:> "*/*"]
          }
@@ -334,9 +324,8 @@ spec = do
      it "indicates no records found to update" $
        request methodPatch "/empty_table" []
          [json| { "extra":20 } |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "",
-            matchStatus  = 204,
+          `shouldRespondWith` ""
+          { matchStatus  = 204,
            matchHeaders = ["Content-Range" <:> "*/*"]
          }

@@ -346,9 +335,8 @@ spec = do
        liftIO $ simpleHeaders g
          `shouldSatisfy` matchHeader "Content-Range" "\\*/\\*"
        p <- request methodPatch "/items?id=eq.2" [] [json| { "id":42 } |]
-        pure p `shouldRespondWith` ResponseMatcher {
-            matchBody    = Nothing,
-            matchStatus  = 204,
+        pure p `shouldRespondWith` ""
+          { matchStatus  = 204,
            matchHeaders = ["Content-Range" <:> "0-0/*"]
          }
        liftIO $ lookup hContentType (simpleHeaders p) `shouldBe` Nothing
@@ -363,8 +351,8 @@ spec = do
      it "returns empty array when no rows updated and return=rep" $
        request methodPatch "/items?id=eq.999999"
          [("Prefer", "return=representation")] [json| { "id":999999 } |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "[]",
+          `shouldRespondWith` "[]"
+          {
            matchStatus  = 200,
            matchHeaders = ["Content-Range" <:> "*/*"]
          }
@@ -372,9 +360,8 @@ spec = do
      it "returns updated object as array when return=rep" $
        request methodPatch "/items?id=eq.2"
          [("Prefer", "return=representation")] [json| { "id":2 } |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":2}]|],
-            matchStatus  = 200,
+          `shouldRespondWith` [str|[{"id":2}]|]
+          { matchStatus  = 200,
            matchHeaders = ["Content-Range" <:> "0-0/*"]
          }

@@ -395,15 +382,15 @@ spec = do
        _ <- request methodPatch "/no_pk?b=eq.nullme" [] [json| { b: null } |]
        get "/no_pk?a=eq.keepme" `shouldRespondWith`
          [json| [{ a: "keepme", b: null }] |]
+          { matchHeaders = [matchContentTypeJson] }

      it "can set a json column to escaped value" $ do
        _ <- post "/json" [json| { data: {"escaped":"bar"} } |]
        request methodPatch "/json?data->>escaped=eq.bar"
                     [("Prefer", "return=representation")]
                     [json| { "data": { "escaped":" \"bar" } } |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json| [{ "data": { "escaped":" \"bar" } }] |]
-          , matchStatus  = 200
+          `shouldRespondWith` [json| [{ "data": { "escaped":" \"bar" } }] |]
+          { matchStatus  = 200
          , matchHeaders = []
          }

@@ -412,9 +399,8 @@ spec = do
          "/items?always_true=eq.false"
          [("Prefer", "return=representation")]
          [json| { id: 100 } |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "[]",
-            matchStatus  = 200,
+          `shouldRespondWith` "[]"
+          { matchStatus  = 200,
            matchHeaders = ["Content-Range" <:> "*/*"]
          }

@@ -426,6 +412,31 @@ spec = do
          [("Prefer", "return=representation")]
          [json| { id: 99 } |]
          `shouldRespondWith` [json| [{id:99}] |]
+          { matchHeaders = [matchContentTypeJson] }
+        -- put value back for other tests
+        void $ request methodPatch "/items?id=eq.99" [] [json| { "id":1 } |]
+
+      it "makes no updates and returns 204, when patching with an empty json object" $ do
+        request methodPatch "/items" [] [json| {} |]
+          `shouldRespondWith` ""
+          {
+            matchStatus  = 204,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
+        g <- get "/items"
+        liftIO $ simpleBody g `shouldBe` [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}] |]
+
+      it "makes no updates and and returns 200, when patching with an empty json object and return=rep" $ do
+        request methodPatch "/items" [("Prefer", "return=representation")] [json| {} |]
+          `shouldRespondWith` "[]"
+          {
+            matchStatus  = 200,
+            matchHeaders = ["Content-Range" <:> "*/*"]
+          }
+
+        g <- get "/items"
+        liftIO $ simpleBody g `shouldBe` [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}] |]

    context "with unicode values" $
      it "succeeds and returns values intact" $ do
@@ -16,9 +16,8 @@ spec =
  describe "Requesting many items with server limits enabled" $ do
    it "restricts results" $
      get "/items"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":2}] |]
-        , matchStatus  = 200
+        `shouldRespondWith` [json| [{"id":1},{"id":2}] |]
+        { matchStatus  = 200
        , matchHeaders = ["Content-Range" <:> "0-1/*"]
        }

@@ -32,17 +31,14 @@ spec =

    it "limit works on all levels" $
      get "/users?select=id,tasks{id}&order=id.asc&tasks.order=id.asc"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [str|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]
-        , matchStatus  = 200
+        `shouldRespondWith` [str|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]
+        { matchStatus  = 200
        , matchHeaders = ["Content-Range" <:> "0-1/*"]
        }

    it "limit is not applied to parent embeds" $
      get "/tasks?select=id,project{id}&id=gt.5"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [str|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
-        , matchStatus  = 200
+        `shouldRespondWith` [str|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
+        { matchStatus  = 200
        , matchHeaders = ["Content-Range" <:> "0-1/*"]
        }
-
@@ -5,6 +5,7 @@ import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus,simpleBody))
+import qualified Data.ByteString.Lazy as BL (empty)

 import SpecHelper
 import Text.Heredoc
@@ -30,68 +31,49 @@ spec = do
  describe "Filtering response" $ do
    it "matches with equality" $
      get "/items?id=eq.5"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":5}] |]
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-0/*"]
-        }
+        `shouldRespondWith` [json| [{"id":5}] |]
+        { matchHeaders = ["Content-Range" <:> "0-0/*"] }

    it "matches with equality using not operator" $
      get "/items?id=not.eq.5"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-13/*"]
-        }
+        `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
+        { matchHeaders = ["Content-Range" <:> "0-13/*"] }

    it "matches with more than one condition using not operator" $
      get "/simple_pk?k=like.*yx&extra=not.eq.u" `shouldRespondWith` "[]"

    it "matches with inequality using not operator" $ do
      get "/items?id=not.lt.14&order=id.asc"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":14},{"id":15}] |]
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-1/*"]
-        }
+        `shouldRespondWith` [json| [{"id":14},{"id":15}] |]
+        { matchHeaders = ["Content-Range" <:> "0-1/*"] }
      get "/items?id=not.gt.2&order=id.asc"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":2}] |]
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-1/*"]
-        }
+        `shouldRespondWith` [json| [{"id":1},{"id":2}] |]
+        { matchHeaders = ["Content-Range" <:> "0-1/*"] }

    it "matches items IN" $
      get "/items?id=in.1,3,5"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":3},{"id":5}] |]
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-2/*"]
-        }
+        `shouldRespondWith` [json| [{"id":1},{"id":3},{"id":5}] |]
+        { matchHeaders = ["Content-Range" <:> "0-2/*"] }

    it "matches items NOT IN" $
      get "/items?id=notin.2,4,6,7,8,9,10,11,12,13,14,15"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":3},{"id":5}] |]
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-2/*"]
-        }
+        `shouldRespondWith` [json| [{"id":1},{"id":3},{"id":5}] |]
+        { matchHeaders = ["Content-Range" <:> "0-2/*"] }

    it "matches items NOT IN using not operator" $
      get "/items?id=not.in.2,4,6,7,8,9,10,11,12,13,14,15"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":3},{"id":5}] |]
-        , matchStatus  = 200
-        , matchHeaders = ["Content-Range" <:> "0-2/*"]
-        }
+        `shouldRespondWith` [json| [{"id":1},{"id":3},{"id":5}] |]
+        { matchHeaders = ["Content-Range" <:> "0-2/*"] }

    it "matches nulls using not operator" $
      get "/no_pk?a=not.is.null" `shouldRespondWith`
        [json| [{"a":"1","b":"0"},{"a":"2","b":"0"}] |]
+        { matchHeaders = [matchContentTypeJson] }

    it "matches nulls in varchar and numeric fields alike" $ do
      get "/no_pk?a=is.null" `shouldRespondWith`
        [json| [{"a": null, "b": null}] |]
+        { matchHeaders = [matchContentTypeJson] }

      get "/nullable_integer?a=is.null" `shouldRespondWith` [str|[{"a":null}]|]

@@ -119,25 +101,28 @@ spec = do
    it "matches with tsearch @@" $
      get "/tsearch?text_search_vector=@@.foo" `shouldRespondWith`
        [json| [{"text_search_vector":"'bar':2 'foo':1"}] |]
+        { matchHeaders = [matchContentTypeJson] }

    it "matches with tsearch @@ using not operator" $
      get "/tsearch?text_search_vector=not.@@.foo" `shouldRespondWith`
        [json| [{"text_search_vector":"'baz':1 'qux':2"}] |]
+        { matchHeaders = [matchContentTypeJson] }

    it "matches with computed column" $
      get "/items?always_true=eq.true&order=id.asc" `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}] |]
+        { matchHeaders = [matchContentTypeJson] }

    it "order by computed column" $
      get "/items?order=anti_id.desc" `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}] |]
+        { matchHeaders = [matchContentTypeJson] }

    it "matches filtering nested items 2" $
      get "/clients?select=id,projects{id,tasks2{id,name}}&projects.tasks.name=like.Design*"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| {"message":"could not find foreign keys between these entities, no relation between projects and tasks2"}|]
-        , matchStatus  = 400
-        , matchHeaders = []
+        `shouldRespondWith` [json| {"message":"Could not find foreign keys between these entities, No relation found between projects and tasks2"}|]
+        { matchStatus  = 400
+        , matchHeaders = [matchContentTypeJson]
        }

    it "matches filtering nested items" $
@@ -166,45 +151,50 @@ spec = do
    it "one simple column" $
      get "/complex_items?select=id" `shouldRespondWith`
        [json| [{"id":1},{"id":2},{"id":3}] |]
+        { matchHeaders = [matchContentTypeJson] }

    it "rename simple column" $
      get "/complex_items?id=eq.1&select=myId:id" `shouldRespondWith`
        [json| [{"myId":1}] |]
+        { matchHeaders = [matchContentTypeJson] }


    it "one simple column with casting (text)" $
      get "/complex_items?select=id::text" `shouldRespondWith`
        [json| [{"id":"1"},{"id":"2"},{"id":"3"}] |]
+        { matchHeaders = [matchContentTypeJson] }

    it "rename simple column with casting" $
      get "/complex_items?id=eq.1&select=myId:id::text" `shouldRespondWith`
        [json| [{"myId":"1"}] |]
+        { matchHeaders = [matchContentTypeJson] }

    it "json column" $
      get "/complex_items?id=eq.1&select=settings" `shouldRespondWith`
        [json| [{"settings":{"foo":{"int":1,"bar":"baz"}}}] |]
+        { matchHeaders = [matchContentTypeJson] }

    it "json subfield one level with casting (json)" $
      get "/complex_items?id=eq.1&select=settings->>foo::json" `shouldRespondWith`
        [json| [{"foo":{"int":1,"bar":"baz"}}] |] -- the value of foo here is of type "text"
+        { matchHeaders = [matchContentTypeJson] }

    it "rename json subfield one level with casting (json)" $
      get "/complex_items?id=eq.1&select=myFoo:settings->>foo::json" `shouldRespondWith`
        [json| [{"myFoo":{"int":1,"bar":"baz"}}] |] -- the value of foo here is of type "text"
+        { matchHeaders = [matchContentTypeJson] }

    it "fails on bad casting (data of the wrong format)" $
      get "/complex_items?select=settings->foo->>bar::integer"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| {"hint":null,"details":null,"code":"22P02","message":"invalid input syntax for integer: \"baz\""} |]
-        , matchStatus  = 400
+        `shouldRespondWith` [json| {"hint":null,"details":null,"code":"22P02","message":"invalid input syntax for integer: \"baz\""} |]
+        { matchStatus  = 400
        , matchHeaders = []
        }

    it "fails on bad casting (wrong cast type)" $
      get "/complex_items?select=id::fakecolumntype"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| {"hint":null,"details":null,"code":"42704","message":"type \"fakecolumntype\" does not exist"} |]
-        , matchStatus  = 400
+        `shouldRespondWith` [json| {"hint":null,"details":null,"code":"42704","message":"type \"fakecolumntype\" does not exist"} |]
+        { matchStatus  = 400
        , matchHeaders = []
        }

@@ -212,19 +202,23 @@ spec = do
    it "json subfield two levels (string)" $
      get "/complex_items?id=eq.1&select=settings->foo->>bar" `shouldRespondWith`
        [json| [{"bar":"baz"}] |]
+        { matchHeaders = [matchContentTypeJson] }

    it "rename json subfield two levels (string)" $
      get "/complex_items?id=eq.1&select=myBar:settings->foo->>bar" `shouldRespondWith`
        [json| [{"myBar":"baz"}] |]
+        { matchHeaders = [matchContentTypeJson] }


    it "json subfield two levels with casting (int)" $
      get "/complex_items?id=eq.1&select=settings->foo->>int::integer" `shouldRespondWith`
        [json| [{"int":1}] |] -- the value in the db is an int, but here we expect a string for now
+        { matchHeaders = [matchContentTypeJson] }

    it "rename json subfield two levels with casting (int)" $
      get "/complex_items?id=eq.1&select=myInt:settings->foo->>int::integer" `shouldRespondWith`
        [json| [{"myInt":1}] |] -- the value in the db is an int, but here we expect a string for now
+        { matchHeaders = [matchContentTypeJson] }

    it "requesting parents and children" $
      get "/projects?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith`
@@ -302,70 +296,70 @@ spec = do
      get "/projects?id=in.1,3&select=id,name,client_id,client{id,name}" `shouldRespondWith`
        [str|[{"id":1,"name":"Windows 7","client_id":1,"client":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client":{"id":2,"name":"Apple"}}]|]

+    it "can detect fk relations through views to tables in the public schema" $
+      get "/consumers_view?select=*,orders_view{*}" `shouldRespondWith` 200
+
+
  describe "ordering response" $ do
    it "by a column asc" $
      get "/items?id=lte.2&order=id.asc"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":1},{"id":2}] |]
-        , matchStatus  = 200
+        `shouldRespondWith` [json| [{"id":1},{"id":2}] |]
+        { matchStatus  = 200
        , matchHeaders = ["Content-Range" <:> "0-1/*"]
        }
    it "by a column desc" $
      get "/items?id=lte.2&order=id.desc"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just [json| [{"id":2},{"id":1}] |]
-        , matchStatus  = 200
+        `shouldRespondWith` [json| [{"id":2},{"id":1}] |]
+        { matchStatus  = 200
        , matchHeaders = ["Content-Range" <:> "0-1/*"]
        }

    it "by a column with nulls first" $
      get "/no_pk?order=a.nullsfirst"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| [{"a":null,"b":null},
+        `shouldRespondWith` [json| [{"a":null,"b":null},
                              {"a":"1","b":"0"},
                              {"a":"2","b":"0"}
                              ] |]
-        , matchStatus = 200
+        { matchStatus = 200
        , matchHeaders = ["Content-Range" <:> "0-2/*"]
        }

    it "by a column asc with nulls last" $
      get "/no_pk?order=a.asc.nullslast"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| [{"a":"1","b":"0"},
+        `shouldRespondWith` [json| [{"a":"1","b":"0"},
                              {"a":"2","b":"0"},
                              {"a":null,"b":null}] |]
-        , matchStatus = 200
+        { matchStatus = 200
        , matchHeaders = ["Content-Range" <:> "0-2/*"]
        }

    it "by a column desc with nulls first" $
      get "/no_pk?order=a.desc.nullsfirst"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| [{"a":null,"b":null},
+        `shouldRespondWith` [json| [{"a":null,"b":null},
                              {"a":"2","b":"0"},
                              {"a":"1","b":"0"}] |]
-        , matchStatus = 200
+        { matchStatus = 200
        , matchHeaders = ["Content-Range" <:> "0-2/*"]
        }

    it "by a column desc with nulls last" $
      get "/no_pk?order=a.desc.nullslast"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody = Just [json| [{"a":"2","b":"0"},
+        `shouldRespondWith` [json| [{"a":"2","b":"0"},
                              {"a":"1","b":"0"},
                              {"a":null,"b":null}] |]
-        , matchStatus = 200
+        { matchStatus = 200
        , matchHeaders = ["Content-Range" <:> "0-2/*"]
        }

    it "by a json column property asc" $
      get "/json?order=data->>id.asc" `shouldRespondWith`
        [json| [{"data": {"id": 0}}, {"data": {"id": 1, "foo": {"bar": "baz"}}}, {"data": {"id": 3}}] |]
+        { matchHeaders = [matchContentTypeJson] }

    it "by a json column with two level property nulls first" $
      get "/json?order=data->foo->>bar.nullsfirst" `shouldRespondWith`
        [json| [{"data": {"id": 3}}, {"data": {"id": 0}}, {"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
+        { matchHeaders = [matchContentTypeJson] }

    it "without other constraints" $
      get "/items?order=id.asc" `shouldRespondWith` 200
@@ -432,18 +426,16 @@ spec = do
    it "should respond with CSV to 'text/csv' request" $
      request methodGet "/simple_pk"
              (acceptHdrs "text/csv; version=1") ""
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just "k,extra\nxyyx,u\nxYYx,v"
-        , matchStatus  = 200
+        `shouldRespondWith` "k,extra\nxyyx,u\nxYYx,v"
+        { matchStatus  = 200
        , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
        }

  describe "Canonical location" $ do
    it "Sets Content-Location with alphabetized params" $
      get "/no_pk?b=eq.1&a=eq.1"
-        `shouldRespondWith` ResponseMatcher {
-          matchBody    = Just "[]"
-        , matchStatus  = 200
+        `shouldRespondWith` "[]"
+        { matchStatus  = 200
        , matchHeaders = ["Content-Location" <:> "/no_pk?a=eq.1&b=eq.1"]
        }

@@ -458,23 +450,26 @@ spec = do
    it "can filter by properties inside json column" $ do
      get "/json?data->foo->>bar=eq.baz" `shouldRespondWith`
        [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
+        { matchHeaders = [matchContentTypeJson] }
      get "/json?data->foo->>bar=eq.fake" `shouldRespondWith`
        [json| [] |]
+        { matchHeaders = [matchContentTypeJson] }
    it "can filter by properties inside json column using not" $
      get "/json?data->foo->>bar=not.eq.baz" `shouldRespondWith`
        [json| [] |]
+        { matchHeaders = [matchContentTypeJson] }
    it "can filter by properties inside json column using ->>" $
      get "/json?data->>id=eq.1" `shouldRespondWith`
        [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]
+        { matchHeaders = [matchContentTypeJson] }

  describe "remote procedure call" $ do
    context "a proc that returns a set" $ do
      it "returns paginated results" $
        request methodPost "/rpc/getitemrange"
                (rangeHdrs (ByteRangeFromTo 0 0))  [json| { "min": 2, "max": 4 } |]
-           `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [json| [{"id":3}] |]
-            , matchStatus = 200
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 200
            , matchHeaders = ["Content-Range" <:> "0-0/*"]
            }

@@ -482,16 +477,15 @@ spec = do
        request methodPost "/rpc/getitemrange"
                (rangeHdrsWithCount (ByteRangeFromTo 0 0))
                [json| { "min": 2, "max": 4 } |]
-           `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [json| [{"id":3}] |]
-            , matchStatus = 206 -- it now knows the response is partial
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 206 -- it now knows the response is partial
            , matchHeaders = ["Content-Range" <:> "0-0/2"]
            }

-
      it "returns proper json" $
        post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
          [json| [ {"id": 3}, {"id":4} ] |]
+          { matchHeaders = [matchContentTypeJson] }

    context "unknown function" $
      it "returns 404" $
@@ -505,12 +499,12 @@ spec = do
      it "can filter proc results" $
        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" [json| {} |] `shouldRespondWith`
          [json|[{"id":2},{"id":3},{"id":4}]|]
+          { matchHeaders = [matchContentTypeJson] }

      it "can limit proc results" $
        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1" [json| {} |]
-          `shouldRespondWith` ResponseMatcher {
-               matchBody    = Just [json|[{"id":3},{"id":4}]|]
-             , matchStatus = 200
+          `shouldRespondWith` [json|[{"id":3},{"id":4}]|]
+             { matchStatus = 200
             , matchHeaders = ["Content-Range" <:> "1-2/*"]
             }

@@ -518,23 +512,75 @@ spec = do
        post "/rpc/getproject?select=id,name" [json| { "id": 1} |] `shouldRespondWith`
          [str|[{"id":1,"name":"Windows 7"}]|]

-      it "can embed foreign entities to the items returned by a proc" $
+    context "foreign entities embedding" $ do
+      it "can embed if related tables are in the exposed schema" $
        post "/rpc/getproject?select=id,name,client{id},tasks{id}" [json| { "id": 1} |] `shouldRespondWith`
          [str|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]

+      it "cannot embed if the related table is not in the exposed schema" $
+        post "/rpc/single_article?select=*,article_stars{*}" [json|{ "id": 1}|]
+          `shouldRespondWith` 400
+
+      it "can embed if the related tables are in a hidden schema but exposed as views" $
+        post "/rpc/single_article?select=id,articleStars{userId}" [json|{ "id": 2}|]
+          `shouldRespondWith` [json|[{"id": 2, "articleStars": [{"userId": 3}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
    context "a proc that returns an empty rowset" $
      it "returns empty json array" $
        post "/rpc/test_empty_rowset" [json| {} |] `shouldRespondWith`
          [json| [] |]
+          { matchHeaders = [matchContentTypeJson] }

-    context "a proc that returns plain text" $ do
-      it "returns proper json" $
-        post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
-          [json|"Hello, world"|]
+    context "proc return types" $ do
+      context "returns text" $ do
+        it "returns proper json" $
+          post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
+            [json|"Hello, world"|]
+            { matchHeaders = [matchContentTypeJson] }

-      it "can handle unicode" $
-        post "/rpc/sayhello" [json| { "name": "￥" } |] `shouldRespondWith`
-          [json|"Hello, ￥"|]
+        it "can handle unicode" $
+          post "/rpc/sayhello" [json| { "name": "￥" } |] `shouldRespondWith`
+            [json|"Hello, ￥"|]
+            { matchHeaders = [matchContentTypeJson] }
+
+      it "returns enum value" $
+        post "/rpc/ret_enum" [json|{ "val": "foo" }|] `shouldRespondWith`
+          [json|"foo"|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns domain value" $
+        post "/rpc/ret_domain" [json|{ "val": "8" }|] `shouldRespondWith`
+          [json|8|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns range" $
+        post "/rpc/ret_range" [json|{ "low": 10, "up": 20 }|] `shouldRespondWith`
+          [json|"[10,20)"|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns row of scalars" $
+        post "/rpc/ret_scalars" [json|{}|] `shouldRespondWith`
+          [json|[{"a":"scalars", "b":"foo", "c":1, "d":"[10,20)"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns composite type in exposed schema" $
+        post "/rpc/ret_point_2d" [json|{}|] `shouldRespondWith`
+          [json|[{"x": 10, "y": 5}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "cannot return composite type in hidden schema" $
+        post "/rpc/ret_point_3d" [json|{}|] `shouldRespondWith` 401
+
+      it "returns single row from table" $
+        post "/rpc/single_article?select=id" [json|{"id": 2}|] `shouldRespondWith`
+          [json|[{"id": 2}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns null for void" $
+        post "/rpc/ret_void" [json|{}|] `shouldRespondWith`
+          [json|null|]
+          { matchHeaders = [matchContentTypeJson] }

    context "improper input" $ do
      it "rejects unknown content type even if payload is good" $
@@ -573,14 +619,17 @@ spec = do
    it "executes the proc exactly once per request" $ do
      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
        [json|1|]
+        { matchHeaders = [matchContentTypeJson] }
      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
        [json|2|]
+        { matchHeaders = [matchContentTypeJson] }

    context "expects a single json object" $ do
      it "does not expand posted json into parameters" $
        request methodPost "/rpc/singlejsonparam"
          [("Prefer","params=single-object")] [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] `shouldRespondWith`
          [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |]
+          { matchHeaders = [matchContentTypeJson] }

      it "accepts parameters from an html form" $
        request methodPost "/rpc/singlejsonparam"
@@ -589,18 +638,169 @@ spec = do
           "boolean=false&date=1900-01-01&money=$3.99&enum=foo") `shouldRespondWith`
          [json| { "integer": "7", "double": "2.71828", "varchar" : "forms are fun"
                 , "boolean":"false", "date":"1900-01-01", "money":"$3.99", "enum":"foo" } |]
+                 { matchHeaders = [matchContentTypeJson] }
+
+    context "a proc that receives no parameters" $
+      it "interprets empty string as empty json object on a post request" $
+        post "/rpc/noparamsproc" BL.empty `shouldRespondWith`
+          [json| "Return value of no parameters procedure." |]
+          { matchHeaders = [matchContentTypeJson] }

  describe "weird requests" $ do
    it "can query as normal" $ do
      get "/Escap3e;" `shouldRespondWith`
        [json| [{"so6meIdColumn":1},{"so6meIdColumn":2},{"so6meIdColumn":3},{"so6meIdColumn":4},{"so6meIdColumn":5}] |]
+        { matchHeaders = [matchContentTypeJson] }
      get "/ghostBusters" `shouldRespondWith`
        [json| [{"escapeId":1},{"escapeId":3},{"escapeId":5}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "fails if an operator is not given" $
+      get "/ghostBusters?id=0" `shouldRespondWith` [json| {"details":"unexpected \"0\" expecting \"not\" or operator (eq, gt, ...)","message":"\"failed to parse filter (0)\" (line 1, column 1)"} |]
+        { matchStatus  = 400
+        , matchHeaders = [matchContentTypeJson]
+        }

    it "will embed a collection" $
      get "/Escap3e;?select=ghostBusters{*}" `shouldRespondWith`
        [json| [{"ghostBusters":[{"escapeId":1}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":3}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":5}]}] |]
+        { matchHeaders = [matchContentTypeJson] }

    it "will embed using a column" $
      get "/ghostBusters?select=escapeId{*}" `shouldRespondWith`
        [json| [{"escapeId":{"so6meIdColumn":1}},{"escapeId":{"so6meIdColumn":3}},{"escapeId":{"so6meIdColumn":5}}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+  describe "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 "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" $
+      request methodPost "/rpc/get_guc_value"
+                [("Custom-Header", "test")]
+          [json| { "name": "request.header.custom-header" } |]
+          `shouldRespondWith`
+          [str|"test"|]
+          { matchStatus  = 200
+          , matchHeaders = [ matchContentTypeJson ]
+          }
+    it "standard header is set" $
+      request methodPost "/rpc/get_guc_value"
+                [("Origin", "http://example.com")]
+          [json| { "name": "request.header.origin" } |]
+          `shouldRespondWith`
+          [str|"http://example.com"|]
+          { matchStatus  = 200
+          , matchHeaders = [ matchContentTypeJson ]
+          }
+    it "current role is available as GUC claim" $
+      request methodPost "/rpc/get_guc_value" []
+          [json| { "name": "request.jwt.claim.role" } |]
+          `shouldRespondWith`
+          [str|"postgrest_test_anonymous"|]
+          { matchStatus  = 200
+          , matchHeaders = [ matchContentTypeJson ]
+          }
+    it "single cookie ends up as claims" $
+      request methodPost "/rpc/get_guc_value" [("Cookie","acookie=cookievalue")]
+        [json| {"name":"request.cookie.acookie"} |]
+          `shouldRespondWith`
+          [str|"cookievalue"|]
+          { matchStatus = 200
+          , matchHeaders = []
+          }
+
+    it "multiple cookies ends up as claims" $
+      request methodPost "/rpc/get_guc_value" [("Cookie","acookie=cookievalue;secondcookie=anothervalue")]
+        [json| {"name":"request.cookie.secondcookie"} |]
+          `shouldRespondWith`
+          [str|"anothervalue"|]
+          { matchStatus = 200
+          , matchHeaders = []
+          }
+
+  describe "values with quotes in IN and NOTIN operators" $ do
+    it "succeeds when only quoted values are present" $ do
+      get "/w_or_wo_comma_names?name=in.\"Hebdon, John\"" `shouldRespondWith`
+        [json| [{"name":"Hebdon, John"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/w_or_wo_comma_names?name=in.\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\"" `shouldRespondWith`
+        [json| [{"name":"Hebdon, John"},{"name":"Williams, Mary"},{"name":"Smith, Joseph"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/w_or_wo_comma_names?name=notin.\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\"" `shouldRespondWith`
+        [json| [{"name":"David White"},{"name":"Larry Thompson"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/w_or_wo_comma_names?name=not.in.\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\"" `shouldRespondWith`
+        [json| [{"name":"David White"},{"name":"Larry Thompson"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "succeeds w/ and w/o quoted values" $ do
+      get "/w_or_wo_comma_names?name=in.David White,\"Hebdon, John\"" `shouldRespondWith`
+        [json| [{"name":"Hebdon, John"},{"name":"David White"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/w_or_wo_comma_names?name=not.in.\"Hebdon, John\",Larry Thompson,\"Smith, Joseph\"" `shouldRespondWith`
+        [json| [{"name":"Williams, Mary"},{"name":"David White"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/w_or_wo_comma_names?name=notin.\"Hebdon, John\",David White,\"Williams, Mary\",Larry Thompson" `shouldRespondWith`
+        [json| [{"name":"Smith, Joseph"}] |]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "checks well formed quoted values" $ do
+      get "/w_or_wo_comma_names?name=in.\"\"Hebdon, John\"" `shouldRespondWith`
+        [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      get "/w_or_wo_comma_names?name=in.\"\"Hebdon, John\"\"Mary" `shouldRespondWith`
+        [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      get "/w_or_wo_comma_names?name=in.Williams\"Hebdon, John\"" `shouldRespondWith`
+        [json| [] |] { matchHeaders = [matchContentTypeJson] }
+
+  describe "IN empty set" $ do
+    context "returns an empty result set when no value is present" $ do
+      it "works for integer" $
+        get "/items_with_different_col_types?int_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for text" $
+        get "/items_with_different_col_types?text_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for bool" $
+        get "/items_with_different_col_types?bool_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for bytea" $
+        get "/items_with_different_col_types?bin_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for char" $
+        get "/items_with_different_col_types?char_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for date" $
+        get "/items_with_different_col_types?date_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for real" $
+        get "/items_with_different_col_types?real_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+      it "works for time" $
+        get "/items_with_different_col_types?time_data=in." `shouldRespondWith`
+          [json| [] |] { matchHeaders = [matchContentTypeJson] }
+
+    it "returns an empty result ignoring spaces" $
+      get "/items_with_different_col_types?int_data=in.    " `shouldRespondWith` 400
+
+    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
@@ -31,19 +31,12 @@ spec = do
      context "when I don't want the count" $ do
        it "returns range Content-Range with */* for empty range" $
          request methodPost "/rpc/getitemrange" [] emptyRange
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [json| [] |]
-            , matchStatus  = 200
-            , matchHeaders = ["Content-Range" <:> "*/*"]
-            }
+            `shouldRespondWith` [json| [] |] {matchHeaders = ["Content-Range" <:> "*/*"]}

        it "returns range Content-Range with range/*" $
          request methodPost "/rpc/getitemrange" [] defaultRange
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
-            , matchStatus  = 200
-            , matchHeaders = ["Content-Range" <:> "0-14/*"]
-            }
+            `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}] |]
+            { matchHeaders = ["Content-Range" <:> "0-14/*"] }

    context "with range headers" $ do

@@ -64,9 +57,8 @@ spec = do
        it "returns an empty body when there are no results" $
          request methodPost "/rpc/getitemrange"
                  (rangeHdrs $ ByteRangeFromTo 0 1) emptyRange
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just "[]"
-            , matchStatus  = 200
+            `shouldRespondWith` "[]"
+            { matchStatus  = 200
            , matchHeaders = ["Content-Range" <:> "*/*"]
            }

@@ -95,18 +87,16 @@ spec = do
        it "refuses a range with nonzero start when there are no items" $
          request methodPost "/rpc/getitemrange"
                  (rangeHdrsWithCount $ ByteRangeFromTo 1 2) emptyRange
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing
-            , matchStatus  = 416
+            `shouldRespondWith` "[]"
+            { matchStatus  = 416
            , matchHeaders = ["Content-Range" <:> "*/0"]
            }

        it "refuses a range requesting start past last item" $
          request methodPost "/rpc/getitemrange"
                  (rangeHdrsWithCount $ ByteRangeFromTo 100 199) defaultRange
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing
-            , matchStatus  = 416
+            `shouldRespondWith` "[]"
+            { matchStatus  = 416
            , matchHeaders = ["Content-Range" <:> "*/15"]
            }

@@ -120,68 +110,58 @@ spec = do
        it "returns range Content-Range with /*" $
          request methodGet "/menagerie"
                  [("Prefer", "count=none")] ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just "[]"
-            , matchStatus  = 200
+            `shouldRespondWith` "[]"
+            { matchStatus  = 200
            , matchHeaders = ["Content-Range" <:> "*/*"]
            }

        it "returns range Content-Range with range/*" $
          request methodGet "/items?order=id"
                  [("Prefer", "count=none")] ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
-            , matchStatus  = 200
-            , matchHeaders = ["Content-Range" <:> "0-14/*"]
-            }
+            `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}] |]
+            { matchHeaders = ["Content-Range" <:> "0-14/*"] }

        it "returns range Content-Range with range/* even using other filters" $
          request methodGet "/items?id=eq.1&order=id"
                  [("Prefer", "count=none")] ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just [json| [{"id":1}] |]
-            , matchStatus  = 200
-            , matchHeaders = ["Content-Range" <:> "0-0/*"]
-            }
+            `shouldRespondWith` [json| [{"id":1}] |]
+            { matchHeaders = ["Content-Range" <:> "0-0/*"] }

    context "with limit/offset parameters" $ do
      it "no parameters return everything" $
        get "/items?select=id&order=id.asc"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
-          , matchStatus  = 200
+          `shouldRespondWith`
+          [str|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
+          { matchStatus  = 200
          , matchHeaders = ["Content-Range" <:> "0-14/*"]
          }
      it "top level limit with parameter" $
        get "/items?select=id&order=id.asc&limit=3"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":1},{"id":2},{"id":3}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [str|[{"id":1},{"id":2},{"id":3}]|]
+          { matchStatus  = 200
          , matchHeaders = ["Content-Range" <:> "0-2/*"]
          }
      it "headers override get parameters" $
        request methodGet  "/items?select=id&order=id.asc&limit=3"
                     (rangeHdrs $ ByteRangeFromTo 0 1) ""
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":1},{"id":2}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [str|[{"id":1},{"id":2}]|]
+          { matchStatus  = 200
          , matchHeaders = ["Content-Range" <:> "0-1/*"]
          }

      it "limit works on all levels" $
        get "/clients?select=id,projects{id,tasks{id}}&order=id.asc&limit=1&projects.order=id.asc&projects.limit=2&projects.tasks.order=id.asc&projects.tasks.limit=1"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]
-          , matchStatus  = 200
+          `shouldRespondWith`
+          [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]
+          { matchStatus  = 200
          , 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` ResponseMatcher {
-            matchBody    = Just [str|[{"id":3},{"id":4},{"id":5}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [str|[{"id":3},{"id":4},{"id":5}]|]
+          { matchStatus  = 200
          , matchHeaders = ["Content-Range" <:> "2-4/*"]
          }

@@ -204,9 +184,8 @@ spec = do
        it "returns an empty body when there are no results" $
          request methodGet "/menagerie"
                  (rangeHdrs $ ByteRangeFromTo 0 1) ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Just "[]"
-            , matchStatus  = 200
+            `shouldRespondWith` "[]"
+            { matchStatus  = 200
            , matchHeaders = ["Content-Range" <:> "*/*"]
            }

@@ -235,17 +214,15 @@ spec = do
        it "refuses a range with nonzero start when there are no items" $
          request methodGet "/menagerie"
                  (rangeHdrsWithCount $ ByteRangeFromTo 1 2) ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing
-            , matchStatus  = 416
+            `shouldRespondWith` "[]"
+            { matchStatus  = 416
            , matchHeaders = ["Content-Range" <:> "*/0"]
            }

        it "refuses a range requesting start past last item" $
          request methodGet "/items"
                  (rangeHdrsWithCount $ ByteRangeFromTo 100 199) ""
-            `shouldRespondWith` ResponseMatcher {
-              matchBody    = Nothing
-            , matchStatus  = 416
+            `shouldRespondWith` "[]"
+            { matchStatus  = 416
            , matchHeaders = ["Content-Range" <:> "*/15"]
            }
@@ -86,16 +86,14 @@ spec =
        request methodPost "/addresses"
          [("Prefer", "return=minimal"), singular]
          [json| [ { id: 101, address: "xxx" } ] |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just ""
-          , matchStatus  = 201
+          `shouldRespondWith` ""
+          { matchStatus  = 201
          , matchHeaders = ["Content-Range" <:> "*/*"]
          }
        -- and the element should exist
        get "/addresses?id=eq.101"
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [str|[{"id":101,"address":"xxx"}]|]
-          , matchStatus  = 200
+          `shouldRespondWith` [str|[{"id":101,"address":"xxx"}]|]
+          { matchStatus  = 200
          , matchHeaders = []
          }

@@ -113,9 +111,8 @@ spec =
        request methodPost "/addresses"
          [("Prefer", "return=minimal"), singular]
          [json| [ { id: 200, address: "xxx" }, { id: 201, address: "yyy" } ] |]
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just ""
-          , matchStatus  = 201
+          `shouldRespondWith` ""
+          { matchStatus  = 201
          , matchHeaders = ["Content-Range" <:> "*/*"]
          }

@@ -142,11 +139,9 @@ spec =
          [("Prefer", "return=representation"), singular] ""
          `shouldRespondWith` 406

-        -- the rows should not exist, either
        get firstItems
-          `shouldRespondWith` ResponseMatcher {
-            matchBody    = Nothing
-          , matchStatus  = 200
+          `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10}] |]
+          { matchStatus  = 200
          , matchHeaders = ["Content-Range" <:> "0-9/*"]
          }

@@ -6,6 +6,8 @@ import Test.Hspec.Wai.JSON
 import Network.Wai (Application)
 import Control.Monad (void)

+import SpecHelper
+
 import Protolude hiding (get)

 spec :: SpecWith Application
@@ -20,3 +22,4 @@ spec =

      get "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF"
        `shouldRespondWith` [json| [{ "هویت": 1 }] |]
+        { matchHeaders = [matchContentTypeJson] }
@@ -25,10 +25,13 @@ import Network.Wai.Test (SResponse(simpleStatus, simpleHeaders, simpleBody))

 import Data.Maybe (fromJust)
 import Data.Aeson (decode, Value(..))
-import qualified Data.JsonSchema.Draft4 as D4
+import qualified JSONSchema.Draft4 as D4

 import Protolude

+matchContentTypeJson :: MatchHeader
+matchContentTypeJson = "Content-Type" <:> "application/json; charset=utf-8"
+
 validateOpenApiResponse :: [Header] -> WaiSession ()
 validateOpenApiResponse headers = do
  r <- request methodGet "/" headers ""
@@ -43,8 +43,10 @@ WHERE pg_stat_activity.datname = '$DB'

 DROP DATABASE IF EXISTS $DB;
 DROP ROLE IF EXISTS $TEST_USER_NAME;
-CREATE USER $TEST_USER_NAME WITH LOGIN NOINHERIT PASSWORD '$TEST_USER_PASS' CREATEROLE;
+CREATE USER $TEST_USER_NAME WITH SUPERUSER LOGIN NOINHERIT PASSWORD '$TEST_USER_PASS' CREATEROLE;
 CREATE DATABASE $DB OWNER $TEST_USER_NAME;
+\\connect $DB
+ALTER SCHEMA public OWNER TO $TEST_USER_NAME;
 EOF

 PGDATABASE=$DB PGOPTIONS='-c client_min_messages=WARNING' psql "$URI" --set=db=$DB -Xq <<EOF
@@ -283,6 +283,17 @@ TRUNCATE TABLE orders CASCADE;
 INSERT INTO orders VALUES (1, 'order 1', 1, 2);
 INSERT INTO orders VALUES (2, 'order 2', 3, 4);

+TRUNCATE TABLE images CASCADE;
+INSERT INTO images(name, img) VALUES ('A.png', decode('iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCC', 'base64'));
+INSERT INTO images(name, img) VALUES ('B.png', decode('iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEX///8AAP94wDzzAAAAL0lEQVQIW2NgwAb+HwARH0DEDyDxwAZEyGAhLODqHmBRzAcn5GAS///A1IF14AAA5/Adbiiz/0gAAAAASUVORK5CYII=', 'base64'));
+
+TRUNCATE TABLE w_or_wo_comma_names CASCADE;
+INSERT INTO w_or_wo_comma_names VALUES ('Hebdon, John');
+INSERT INTO w_or_wo_comma_names VALUES ('Williams, Mary');
+INSERT INTO w_or_wo_comma_names VALUES ('Smith, Joseph');
+INSERT INTO w_or_wo_comma_names VALUES ('David White');
+INSERT INTO w_or_wo_comma_names VALUES ('Larry Thompson');
+
 --
 -- PostgreSQL database dump complete
 --
@@ -1,3 +1,3 @@
 set client_min_messages to warning;
-DROP SCHEMA IF EXISTS test, private, postgrest, jwt, تست CASCADE;
-DROP TYPE IF EXISTS jwt_token CASCADE;
+DROP SCHEMA IF EXISTS test, private, postgrest, jwt, public, تست CASCADE;
+DROP TYPE IF EXISTS jwt_token CASCADE;
@@ -3,6 +3,7 @@ GRANT USAGE ON SCHEMA
      postgrest
    , test
    , jwt
+    , public
    , "تست"
 TO postgrest_test_anonymous;

@@ -44,6 +45,14 @@ GRANT ALL ON TABLE
    , "موارد"
    , addresses
    , orders
+    , public.public_consumers
+    , public.public_orders
+    , consumers_view
+    , orders_view
+    , images
+    , images_base64
+    , w_or_wo_comma_names
+    , items_with_different_col_types
 TO postgrest_test_anonymous;

 GRANT INSERT ON TABLE insertonly TO postgrest_test_anonymous;
@@ -4,4 +4,4 @@ CREATE ROLE postgrest_test_anonymous;
 CREATE ROLE postgrest_test_default_role;
 CREATE ROLE postgrest_test_author;

-GRANT postgrest_test_anonymous, postgrest_test_default_role, postgrest_test_author TO :USER;
+GRANT postgrest_test_anonymous, postgrest_test_default_role, postgrest_test_author TO :USER;
@@ -12,31 +12,10 @@ SET standard_conforming_strings = on;
 SET check_function_bodies = false;
 SET client_min_messages = warning;

--
-- Name: postgrest; Type: SCHEMA; Schema: -; Owner: -
--
-
+CREATE SCHEMA public;
 CREATE SCHEMA postgrest;
-
-
--
-- Name: private; Type: SCHEMA; Schema: -; Owner: -
--
-
 CREATE SCHEMA private;
-
-
--
-- Name: test; Type: SCHEMA; Schema: -; Owner: -
--
-
 CREATE SCHEMA test;
-
-
--
-- Name: تست; Type: SCHEMA; Schema: -; Owner: -
--
-
 CREATE SCHEMA تست;


@@ -48,11 +27,13 @@ CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog;

 SET search_path = public, pg_catalog;

+CREATE EXTENSION IF NOT EXISTS pgcrypto;
+
 --
 -- Name: jwt_token; Type: TYPE; Schema: public; Owner: -
 --

-CREATE TYPE jwt_token AS (
+CREATE TYPE public.jwt_token AS (
 	token text
 );

@@ -142,6 +123,19 @@ CREATE FUNCTION always_true(test.items) RETURNS boolean
    AS $$ SELECT true $$;


+create table public_consumers (
+    id                  serial             not null unique,
+    name                text               not null check (name <> ''),
+    primary key (id)
+);
+
+create table public_orders (
+    id                  serial             not null unique,
+    consumer            integer            not null references public_consumers(id),
+    number              integer            not null,
+    primary key (id)
+);
+
 --
 -- Name: anti_id(test.items); Type: FUNCTION; Schema: public; Owner: -
 --
@@ -161,6 +155,14 @@ CREATE TABLE موارد (

 SET search_path = test, pg_catalog;

+
+create view orders_view as
+  select * from public.public_orders;
+
+create view consumers_view as
+  select * from public.public_consumers;
+
+
 --
 -- Name: getitemrange(bigint, bigint); Type: FUNCTION; Schema: test; Owner: -
 --
@@ -171,6 +173,15 @@ CREATE FUNCTION getitemrange(min bigint, max bigint) RETURNS SETOF items
    SELECT * FROM test.items WHERE id > $1 AND id <= $2;
 $_$;

+--
+-- Name: version(); Type: FUNCTION; Schema: test; Owner: -
+--
+
+CREATE FUNCTION noparamsproc() RETURNS text
+	LANGUAGE sql
+	AS $$
+		SELECT a FROM (VALUES ('Return value of no parameters procedure.')) s(a);
+	$$;

 --
 -- Name: insert_insertable_view_with_join(); Type: FUNCTION; Schema: test; Owner: -
@@ -305,6 +316,7 @@ $$;

 CREATE FUNCTION sayhello(name text) RETURNS text
    LANGUAGE sql
+    IMMUTABLE
    AS $_$
    SELECT 'Hello, ' || $1;
 $_$;
@@ -1097,6 +1109,71 @@ CREATE FUNCTION setprojects(id_l int, id_h int, name text) RETURNS SETOF project
    update test.projects set name = $3 WHERE id >= $1 AND id <= $2 returning *;
 $_$;

+create table images (
+	name               text not null,
+	img                bytea not null
+);
+
+create view images_base64 as (
+  select name, replace(encode(img, 'base64'), E'\n', '') as img from images
+);
+
+create function test.ret_enum(val text) returns test.enum_menagerie_type as $$ 
+  select val::test.enum_menagerie_type;
+$$ language sql;
+
+create domain one_nine as integer check (value >= 1 and value <= 9);
+
+create function test.ret_domain(val integer) returns test.one_nine as $$ 
+  select val::test.one_nine;
+$$ language sql;
+
+create function test.ret_range(low integer, up integer) returns int4range as $$
+  select int4range(low, up);
+$$ language sql;
+
+create function test.ret_scalars() returns table(
+  a text, b test.enum_menagerie_type, c test.one_nine, d int4range
+) as $$ 
+  select row('scalars'::text, enum_first(null::test.enum_menagerie_type), 
+              1::test.one_nine, int4range(10, 20));
+$$ language sql;
+
+create type test.point_2d as (x integer, y integer);
+
+create function test.ret_point_2d() returns test.point_2d as $$ 
+  select row(10, 5)::test.point_2d;
+$$ language sql;
+
+create type private.point_3d as (x integer, y integer, z integer);
+
+create function test.ret_point_3d() returns private.point_3d as $$ 
+  select row(7, -3, 4)::private.point_3d;
+$$ language sql;
+
+create function test.ret_void() returns void as '' language sql;
+
+create function test.single_article(id integer) returns test.articles as $$ 
+  select a.* from test.articles a where a.id = $1;
+$$ language sql;
+
+create function test.get_guc_value(name text) returns text as $$ 
+  select nullif(current_setting(name), '')::text;
+$$ language sql;
+
+create table w_or_wo_comma_names ( name text );
+
+create table items_with_different_col_types ( 
+  int_data integer,
+  text_data text,
+  bool_data bool,
+  bin_data bytea,
+  char_data character varying,
+  date_data date,
+  real_data real,
+  time_data time
+);
+
 --
 -- PostgreSQL database dump complete
 --
Author	SHA1	Message	Date
Joe Nelson	c912601e1c	Merge branch 'build-0.4.1.0'	2017-04-30 00:06:25 -05:00
Joe Nelson	7ba880e902	Re-enable openapi tests on CI	2017-04-29 21:07:42 -05:00
Joe Nelson	d99462be01	Revert "Fix swagger-ui when "server-proxy-uri" is not set (#857 )" This was a bug in swagger-ui, not postgrest	2017-04-29 21:02:14 -05:00
Joe Nelson	0b436d49e6	Bump version	2017-04-29 21:02:14 -05:00
Joe NelsonandGitHub	f4d84e4b58	Fix deploy to heroku button for v0.4 (#863 ) * Bring back the Heroku button! * New params for updated buildpack	2017-04-19 19:12:58 -05:00
Joe Nelson	c8f4173262	Add link to patreon campaign	2017-04-13 17:31:14 -05:00
Steve ChávezandJoe Nelson	0a9d9cdded	Fix #701 : allow quoted values for IN operator, refactor and Fix #641 : allow IN filter to have no values (#854 )	2017-04-11 00:57:44 -05:00
Ruslan TalpaandJoe Nelson	5fffbbe381	Make HTTP headers available as GUCs #800 (#849 )	2017-04-10 19:23:48 -05:00
Joe NelsonandGitHub	3e7a8b5f85	Use union merge strategy on changelog (#859 )	2017-04-08 10:36:02 -05:00
Marios KoulakisandJoe Nelson	8557ee55f5	Update with empty json (#852 )	2017-04-07 22:21:50 -05:00
Joe NelsonandGitHub	56bdf59e14	Read only proc tx (#844 )	2017-04-07 12:52:16 -05:00
Feynman LiangandJoe Nelson	77af16c9e4	Fix swagger-ui when "server-proxy-uri" is not set (#857 )	2017-04-07 08:51:29 -05:00
Feynman LiangandJoe Nelson	0cf49bb8b6	Adds application/json to inspect type (#853 )	2017-04-06 10:43:56 -05:00
Ted KornishandJoe Nelson	10f6ce45db	Add instructions on running tests to CONTRIBUTING.md (#793 )	2017-04-04 22:08:39 -05:00
Marios KoulakisandJoe Nelson	9b4b45671c	Accept empty string as empty json body when calling an rpc (#832 )	2017-03-27 21:34:03 -07:00
Steve FarmerandJoe Nelson	0b486ccf44	Increase Warp connection timeout (#834 )	2017-03-21 19:50:24 -07:00
Steve ChávezandJoe Nelson	47b023e858	Fix proc resource embedding issue with search_path and refactor return type (#831 )	2017-03-20 23:50:42 -07:00
Diogo BiazusandJoe Nelson	206ab163b6	Refactor error type and fix nested error message [fix #791 ] (#829 )	2017-03-12 22:02:13 -07:00
Joe NelsonandGitHub	2aabbbae58	Dockerfile that works with postgrest 0.4 (#810 ) Also an example docker-compose	2017-02-17 23:43:35 -08:00
Diogo BiazusandJoe Nelson	728e40c96c	Update hspec-wai to 0.8.0 (#799 )	2017-02-14 21:18:01 -08:00
Steve ChávezandJoe Nelson	98438c437f	Proposal for binary output (#802 )	2017-02-14 20:36:51 -08:00
Joe NelsonandGitHub	84f68c68cb	Public schema table embedding (#803 ) * Alter fixture to test objects in public schema Properly erase and restore the public schema -- requires permissions to install pgcrypto each time. * Test for fks through public schema tables * Thanks @fab1an	2017-02-12 16:32:15 -08:00
Pi3randJoe Nelson	1d8318ce26	Increase lower and upper bound for optparse-applicative (#794 )	2017-02-03 10:00:13 -08:00
Joe Nelson	a61c783e2d	Add link to config docs in message	2017-01-22 16:18:41 -08:00
Joe Nelson	69fd5f1b33	HTTP for docs link	2017-01-20 00:39:23 -08:00