Bump to 0.4.4.0

Also trim trailing whitespace

.circleci/config.yml

@@ -53,7 +53,14 @@ build-distro-bin: &build-distro-bin
 
 jobs:
   build-test:
-    machine: true
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:9.4.14
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
     steps:
       - checkout
       - restore_cache:
@@ -65,8 +72,9 @@ jobs:
             curl -L https://github.com/commercialhaskell/stack/releases/download/v1.1.2/stack-1.1.2-linux-x86_64.tar.gz | tar zx -C /tmp
             sudo mv /tmp/stack-1.1.2-linux-x86_64/stack /usr/bin
             sudo apt-get update
-            sudo apt-get install libgmp-dev
+            sudo apt-get install -y libgmp-dev
-            sudo apt-get install --only-upgrade binutils
+            sudo apt-get install -y --only-upgrade binutils
+            sudo apt-get install -y postgresql-client
             stack setup
             rm -rf $(stack path --dist-dir) $(stack path --local-install-root)
             stack install hlint packdeps cabal-install
@@ -78,7 +86,6 @@ jobs:
       - run:
           name: run tests
           command: |
-            sudo service postgresql start
             POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test
             test/io-tests.sh
       - run:
@@ -99,6 +106,38 @@ jobs:
             - ".stack-work"
           key: v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
 
+  build-test-9.6:
+    docker:
+      - image: circleci/buildpack-deps:trusty
+        environment:
+          - PGHOST=localhost
+      - image: circleci/postgres:9.6.2
+        environment:
+          - POSTGRES_USER=circleci
+          - POSTGRES_DB=circleci
+    steps:
+      - checkout
+      - restore_cache:
+          keys:
+          - v1-stack-dependencies-{{ checksum "postgrest.cabal" }}-{{ checksum "stack.yaml" }}
+      - run:
+          name: install stack & dependencies
+          command: |
+            curl -L https://github.com/commercialhaskell/stack/releases/download/v1.1.2/stack-1.1.2-linux-x86_64.tar.gz | tar zx -C /tmp
+            sudo mv /tmp/stack-1.1.2-linux-x86_64/stack /usr/bin
+            sudo apt-get update
+            sudo apt-get install -y libgmp-dev
+            sudo apt-get install -y postgresql-client
+            stack setup
+      - run:
+          name: build src and tests
+          command: |
+            stack build --fast -j1
+            stack build --fast --test --no-run-tests
+      - run:
+          name: run tests
+          command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test
+
   centos6:
     <<: *build-distro-bin
 
@@ -145,9 +184,14 @@ workflows:
           filters:
             tags:
               only: /v[0-9]+(\.[0-9]+)*/
+      - build-test-9.6:
+          filters:
+            tags:
+              only: /v[0-9]+(\.[0-9]+)*/
       - centos6:
           requires:
             - build-test
+            - build-test-9.6
           filters:
             tags:
               only: /v[0-9]+(\.[0-9]+)*/
@@ -156,6 +200,7 @@ workflows:
       - centos7:
           requires:
             - build-test
+            - build-test-9.6
           filters:
             tags:
               only: /v[0-9]+(\.[0-9]+)*/
@@ -164,6 +209,7 @@ workflows:
       - ubuntu:
           requires:
             - build-test
+            - build-test-9.6
           filters:
             tags:
               only: /v[0-9]+(\.[0-9]+)*/
@@ -172,6 +218,7 @@ workflows:
       - ubuntui386:
           requires:
             - build-test
+            - build-test-9.6
           filters:
             tags:
               only: /v[0-9]+(\.[0-9]+)*/

CHANGELOG.md

@@ -9,6 +9,31 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
 ### Fixed
 
+## [0.4.4.0] - 2018-01-08
+
+### Added
+
+- #887, #601, #1007, Allow specifying dictionary and plain/phrase tsquery in full text search - @steve-chavez
+- #328, Allow doing GET on rpc - @steve-chavez
+- #917, Add ability to map RAISE errorcode/message to http status - @steve-chavez
+- #940, Add ability to map GUC to http response headers - @steve-chavez
+- #1022, Include git sha in version report - @begriffs
+- Faster queries using json_agg - @ruslantalpa
+
+### Fixed
+
+- #876, Read secret files as binary, discard final LF if any - @eric-brechemier
+- #968, Treat blank proxy uri as missing - @begriffs
+- #933, OpenAPI externals docs url to current version - @steve-chavez
+- #962, OpenAPI don't err on nonexistent schema - @steve-chavez
+- #954, make OpenAPI rpc output dependent on user privileges - @steve-chavez
+- #955, Support configurable aud claim - @statik
+- #996, Fix embedded column conflicts table name - @grotsev
+- #974, Fix RPC error when function has single OUT param - @steve-chavez
+- #1021, Reduce join size in allColumns for faster program start - @nextstopsun
+- #411, Remove the need for pk in &select for parent embed - @steve-chavez
+- #1016, Fix anonymous requests when configured with jwt-aud - @ruslantalpa
+
 ## [0.4.3.0] - 2017-09-06
 
 ### Added

README.md

@@ -6,6 +6,7 @@
 </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)](http://postgrest.com)
+[![Docker Stars](https://img.shields.io/docker/pulls/postgrest/postgrest.svg)](https://hub.docker.com/r/postgrest/postgrest/)
 
 PostgREST serves a fully RESTful API from any existing PostgreSQL
 database. It provides a cleaner, more standards-compliant, faster

app.json

@@ -10,7 +10,7 @@
     },
     "POSTGREST_VER": {
       "description": "Version of PostgREST to deploy",
-      "value": "0.4.3.0"
+      "value": "0.4.4.0"
     },
     "DB_URI": {
       "description": "Database connection string",
@@ -43,6 +43,10 @@
       "required": false,
       "value": "false"
     },
+    "JWT_AUD": {
+      "description": "The audience that should be validated if the JWT token contains an aud claim",
+      "required": false
+    },
     "MAX_ROWS": {
       "description": "A hard limit to the number of rows PostgREST will fetch from a view, table, or stored procedure",
       "required": false

docker/Dockerfile

@@ -30,9 +30,10 @@ ENV PGRST_DB_URI= \
     PGRST_DB_POOL=100 \
     PGRST_SERVER_HOST=*4 \
     PGRST_SERVER_PORT=3000 \
-    PGRST_SERVER_PROXY_URL= \
+    PGRST_SERVER_PROXY_URI= \
     PGRST_JWT_SECRET= \
     PGRST_SECRET_IS_BASE64=false \
+    PGRST_JWT_AUD= \
     PGRST_MAX_ROWS= \
     PGRST_PRE_REQUEST=
 

docker/postgrest.conf

@@ -9,6 +9,7 @@ server-port = "$(PGRST_SERVER_PORT)"
 server-proxy-uri = "$(PGRST_SERVER_PROXY_URI)"
 jwt-secret = "$(PGRST_JWT_SECRET)"
 secret-is-base64 = "$(PGRST_SECRET_IS_BASE64)"
+jwt-aud = "$(PGRST_JWT_AUD)"
 
 max-rows = "$(PGRST_MAX_ROWS)"
 pre-request = "$(PGRST_PRE_REQUEST)"

main/Main.hs

@@ -2,31 +2,29 @@
 
 module Main where
 
+
 import           PostgREST.App            (postgrest)
 import           PostgREST.Config         (AppConfig (..),
-                                           PgVersion (..),
                                            minimumPgVersion,
                                            prettyVersion, readOptions)
-import           PostgREST.DbStructure    (getDbStructure)
+import           PostgREST.DbStructure    (getDbStructure, getPgVersion)
 import           PostgREST.Error          (encodeError)
 import           PostgREST.OpenAPI        (isMalformedProxyUri)
-import           PostgREST.Types          (DbStructure, Schema)
+import           PostgREST.Types          (DbStructure, Schema, PgVersion(..))
-import           Protolude hiding         (replace, hPutStrLn)
+import           Protolude                hiding (hPutStrLn, replace)
 
 import           Control.Retry            (RetryStatus, capDelay,
                                            exponentialBackoff,
                                            retrying, rsPreviousDelay)
-import           Data.ByteString.Base64   (decode)
+import qualified Data.ByteString          as BS
+import qualified Data.ByteString.Base64   as B64
 import           Data.IORef               (IORef, atomicWriteIORef,
                                            newIORef, readIORef)
 import           Data.String              (IsString (..))
 import           Data.Text                (pack, replace, stripPrefix, strip)
 import           Data.Text.Encoding       (decodeUtf8, encodeUtf8)
-import           Data.Text.IO             (hPutStrLn, readFile)
+import           Data.Text.IO             (hPutStrLn)
-import qualified Hasql.Decoders           as HD
-import qualified Hasql.Encoders           as HE
 import qualified Hasql.Pool               as P
-import qualified Hasql.Query              as H
 import qualified Hasql.Session            as H
 import           Network.Wai.Handler.Warp (defaultSettings,
                                            runSettings, setHost,
@@ -38,19 +36,6 @@ import           System.IO                (BufferMode (..),
 import           System.Posix.Signals
 #endif
 
-{-|
-	Used by connectionWorker to know if it should throw an error and kill the
-  main thread.
--}
-isServerVersionSupported :: H.Session Bool
-isServerVersionSupported = do
-  ver <- H.query () pgVersion
-  return $ ver >= pgvNum minimumPgVersion
- where
-  pgVersion =
-    H.statement "SELECT current_setting('server_version_num')::integer"
-      HE.unit (HD.singleRow $ HD.value HD.int4) False
-
 {-|
   The purpose of this worker is to fill the refDbStructure created in 'main'
   with the 'DbStructure' returned from calling 'getDbStructure'. This method
@@ -70,7 +55,7 @@ isServerVersionSupported = do
      goes back to 1, otherwise it finishes his work successfully.
 -}
 connectionWorker
-  :: ThreadId -- ^ This thread is killed if 'isServerVersionSupported' returns false
+  :: ThreadId -- ^ This thread is killed if pg version is unsupported
   -> P.Pool   -- ^ The PostgreSQL connection pool
   -> Schema   -- ^ Schema PostgREST is serving up
   -> IORef (Maybe DbStructure) -- ^ mutable reference to 'DbStructure'
@@ -88,13 +73,13 @@ connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
       connected <- connectingSucceeded pool
       when connected $ do
         result <- P.use pool $ do
-          supported <- isServerVersionSupported
+          actualPgVersion <- getPgVersion
-          unless supported $ liftIO $ do
+          unless (actualPgVersion >= minimumPgVersion) $ liftIO $ do
             hPutStrLn stderr
               ("Cannot run in this PostgreSQL version, PostgREST needs at least "
               <> pgvName minimumPgVersion)
             killThread mainTid
-          dbStructure <- getDbStructure schema
+          dbStructure <- getDbStructure schema actualPgVersion
           liftIO $ atomicWriteIORef refDbStructure $ Just dbStructure
         case result of
           Left e -> do
@@ -105,7 +90,6 @@ connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
             atomicWriteIORef refIsWorkerOn False
             putStrLn ("Connection successful" :: Text)
 
-
 {-|
   Used by 'connectionWorker' to check if the provided db-uri lets
   the application access the PostgreSQL database. This method is used
@@ -264,14 +248,16 @@ loadSecretFile conf = extractAndTransform mSecret
       fmap setSecret $
       transformString isB64 =<<
       case stripPrefix "@" secret of
-        Nothing       -> return secret
+        Nothing       -> return . encodeUtf8 $ secret
-        Just filename -> readFile (toS filename)
+        Just filename -> chomp <$> BS.readFile (toS filename)
+      where
+        chomp bs = fromMaybe bs (BS.stripSuffix "\n" bs)
     --
     -- Turns the Base64url encoded JWT into Base64
-    transformString :: Bool -> Text -> IO ByteString
+    transformString :: Bool -> ByteString -> IO ByteString
-    transformString False t = return . encodeUtf8 $ t
+    transformString False t = return t
     transformString True t =
-      case decode (encodeUtf8 $ strip $ replaceUrlChars t) of
+      case B64.decode $ encodeUtf8 $ strip $ replaceUrlChars $ decodeUtf8 t of
         Left errMsg -> panic $ pack errMsg
         Right bs    -> return bs
     setSecret bs = conf {configJwtSecret = Just bs}

postgrest.cabal

@@ -2,7 +2,7 @@ name:                  postgrest
 description:           Reads the schema of a PostgreSQL database and creates RESTful routes
                        for the tables and views, supporting all HTTP verbs that security
                        permits.
-version:               0.4.3.0
+version:               0.4.4.0
 synopsis:              REST API for any Postgres database
 license:               MIT
 license-file:          LICENSE
@@ -58,6 +58,7 @@ library
                      , containers
                      , contravariant
                      , either
+                     , gitrev
                      , hasql
                      , hasql-pool == 0.4.1
                      , hasql-transaction == 0.5
@@ -66,7 +67,7 @@ library
                      , http-types
                      , insert-ordered-containers
                      , interpolatedstring-perl6
-                     , jose
+                     , jose >= 0.6
                      , lens
                      , lens-aeson
                      , network-uri
@@ -110,7 +111,8 @@ Test-Suite spec
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   Hs-Source-Dirs:      test
   Main-Is:             Main.hs
-  Other-Modules:       Feature.AuthSpec
+  Other-Modules:       Feature.AudienceJwtSecretSpec
+                     , Feature.AuthSpec
                      , Feature.AsymmetricJwtSpec
                      , Feature.BinaryJwtSecretSpec
                      , Feature.ConcurrentSpec
@@ -118,6 +120,7 @@ Test-Suite spec
                      , Feature.DeleteSpec
                      , Feature.InsertSpec
                      , Feature.NoJwtSpec
+                     , Feature.PgVersion96Spec
                      , Feature.ProxySpec
                      , Feature.QueryLimitedSpec
                      , Feature.QuerySpec
@@ -126,6 +129,8 @@ Test-Suite spec
                      , Feature.StructureSpec
                      , Feature.UnicodeSpec
                      , Feature.AndOrParamsSpec
+                     , Feature.RpcSpec
+                     , Feature.NonexistentSchemaSpec
                      , SpecHelper
                      , TestTypes
   Build-Depends:       aeson
@@ -141,7 +146,6 @@ Test-Suite spec
                      , hasql
                      , hasql-pool
                      , heredoc
-                     , hjsonpointer
                      , hjsonschema == 1.5.0.1
                      , hspec
                      , hspec-wai >= 0.7.0

src/PostgREST/ApiRequest.hs

@@ -19,7 +19,7 @@ import qualified Data.ByteString.Internal  as BS (c2w)
 import qualified Data.ByteString.Lazy      as BL
 import qualified Data.Csv                  as CSV
 import qualified Data.List                 as L
-import           Data.List                 (lookup, last)
+import           Data.List                 (lookup, last, partition)
 import qualified Data.HashMap.Strict       as M
 import qualified Data.Set                  as S
 import           Data.Maybe                (fromJust)
@@ -38,7 +38,9 @@ import           PostgREST.Types           ( QualifiedIdentifier (..)
                                            , PayloadJSON(..)
                                            , ContentType(..)
                                            , ApiRequestError(..)
-                                           , toMime)
+                                           , toMime
+                                           , operators
+                                           , ftsOperators)
 import           Data.Ranged.Ranges        (Range(..), rangeIntersection, emptyRange)
 import qualified Data.CaseInsensitive      as CI
 import           Web.Cookie                (parseCookiesText)
@@ -48,7 +50,7 @@ type RequestBody = BL.ByteString
 -- | Types of things a user wants to do to tables/views/procs
 data Action = ActionCreate | ActionRead
             | ActionUpdate | ActionDelete
-            | ActionInfo   | ActionInvoke
+            | ActionInfo   | ActionInvoke{isReadOnly :: Bool}
             | ActionInspect
             deriving Eq
 -- | The target db object of a user action
@@ -100,12 +102,14 @@ data ApiRequest = ApiRequest {
   , iHeaders :: [(Text, Text)]
   -- | Request Cookies
   , iCookies :: [(Text, Text)]
+  -- | Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
+  , iRpcQParams :: [(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 ActionInappropriate
+  | isTargetingProc && method `notElem` ["GET", "POST"] = Left ActionInappropriate
   | topLevelRange == emptyRange = Left InvalidRange
   | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) undefined payload
   | otherwise = Right ApiRequest {
@@ -118,7 +122,8 @@ userApiRequest schema req reqBody
       , iPreferRepresentation = representation
       , iPreferSingleObjectParameter = singleObject
       , iPreferCount = hasPrefer "count=exact"
-      , iFilters = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
+      , iFilters = filters
+      , iRpcQParams = rpcQParams
       , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
       , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
       , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
@@ -132,6 +137,15 @@ userApiRequest schema req reqBody
       , iCookies = fromMaybe [] $ parseCookiesText <$> lookupHeader "Cookie"
       }
  where
+  (filters, rpcQParams) =
+    case action of
+      ActionInvoke{isReadOnly=True} -> partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
+      _ -> (flts, [])
+  flts = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
+  hasOperator val = any (`T.isPrefixOf` val) $
+                      ((<> ".") <$> "not":M.keys operators) ++
+                      ((<> "(") <$> M.keys ftsOperators)
+  isEmbedPath = T.isInfixOf "."
   isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path
   payload =
     case decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type" of
@@ -150,17 +164,19 @@ userApiRequest schema req reqBody
       ct ->
         Left $ toS $ "Content-Type not acceptable: " <> toMime ct
   topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges
-  action = case method of
+  action =
-            "GET"     -> if target == TargetRoot
+    case method of
-                          then ActionInspect
+      "GET"      | target == TargetRoot -> ActionInspect
-                          else ActionRead
+                 | isTargetingProc -> ActionInvoke{isReadOnly=True}
-            "POST"    -> if isTargetingProc
+                 | otherwise -> ActionRead
-                          then ActionInvoke
+
-                          else ActionCreate
+      "POST"    -> if isTargetingProc
-            "PATCH"   -> ActionUpdate
+                    then ActionInvoke{isReadOnly=False}
-            "DELETE"  -> ActionDelete
+                    else ActionCreate
-            "OPTIONS" -> ActionInfo
+      "PATCH"   -> ActionUpdate
-            _         -> ActionInspect
+      "DELETE"  -> ActionDelete
+      "OPTIONS" -> ActionInfo
+      _         -> ActionInspect
   target = case path of
               []            -> TargetRoot
               [table]       -> TargetIdent
@@ -168,10 +184,10 @@ userApiRequest schema req reqBody
               ["rpc", proc] -> TargetProc
                               $ QualifiedIdentifier schema proc
               other         -> TargetUnknown other
-  shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionInvoke]
+  shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionInvoke{isReadOnly=False}]
-  relevantPayload = if shouldParsePayload
+  relevantPayload | action == ActionInvoke{isReadOnly=True} = Nothing
-                      then rightToMaybe payload
+                  | shouldParsePayload = rightToMaybe payload
-                      else Nothing
+                  | otherwise = Nothing
   path            = pathInfo req
   method          = requestMethod req
   hdrs            = requestHeaders req

src/PostgREST/App.hs

@@ -6,6 +6,7 @@ module PostgREST.App (
 ) where
 
 import           Control.Applicative
+import           Data.Aeson                (toJSON, eitherDecode)
 import qualified Data.ByteString.Char8     as BS
 import           Data.Maybe
 import           Data.IORef                (IORef, readIORef)
@@ -37,12 +38,13 @@ import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.DbStructure
 import           PostgREST.DbRequestBuilder( readRequest
                                            , mutateRequest
+                                           , readRpcRequest
                                            , fieldNames
                                            )
 import           PostgREST.Error           ( simpleError, pgError
                                            , apiRequestError
                                            , singularityError, binaryFieldError
-                                           , connectionLostError
+                                           , connectionLostError, gucHeadersError
                                            )
 import           PostgREST.RangeQuery      (allRange, rangeOffset)
 import           PostgREST.Middleware
@@ -74,7 +76,7 @@ postgrest conf refDbStructure pool worker =
         response <- case userApiRequest (configSchema conf) req body of
           Left err -> return $ apiRequestError err
           Right apiRequest -> do
-            eClaims <- jwtClaims jwtSecret (toS $ iJWT apiRequest)
+            eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest)
 
             let authed = containsRole eClaims
                 handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
@@ -82,19 +84,16 @@ postgrest conf refDbStructure pool worker =
                   (iTarget apiRequest) (iAction apiRequest)
             response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq
             return $ either (pgError authed) identity response
-        when (isResponse503 response) worker
+        when (responseStatus response == status503) worker
         respond response
 
-isResponse503 :: Response -> Bool
-isResponse503 resp = statusCode (responseStatus resp) == 503
-
 transactionMode :: DbStructure -> Target -> Action -> H.Mode
 transactionMode structure target action =
   case action of
     ActionRead -> HT.Read
     ActionInfo -> HT.Read
     ActionInspect -> HT.Read
-    ActionInvoke ->
+    ActionInvoke{isReadOnly=False} ->
       let proc =
             case target of
               (TargetProc qi) -> M.lookup (qiName qi) $
@@ -104,6 +103,7 @@ transactionMode structure target action =
       if v == Stable || v == Immutable
          then HT.Read
          else HT.Write
+    ActionInvoke{isReadOnly=True} -> HT.Read
     _ -> HT.Write
 
 app :: DbStructure -> AppConfig -> ApiRequest -> H.Transaction Response
@@ -227,7 +227,7 @@ app dbStructure conf apiRequest =
               let acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
               return $ responseLBS status200 [allOrigins, acceptH] ""
 
-        (ActionInvoke, TargetProc qi, Just (PayloadJSON payload)) ->
+        (ActionInvoke _isReadOnly, TargetProc qi, payload) ->
           let proc = M.lookup (qiName qi) allProcs
               returnsScalar = case proc of
                 Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
@@ -235,26 +235,33 @@ app dbStructure conf apiRequest =
               rpcBinaryField = if returnsScalar
                                  then Right Nothing
                                  else binaryField contentType =<< fldNames
-              partsField = (,) <$> readSqlParts <*> rpcBinaryField in
+              parts = (,,) <$> readSqlParts <*> rpcBinaryField <*> rpcQParams in
-          case partsField of
+          case parts of
             Left errorResponse -> return errorResponse
-            Right ((q, cq), bField) -> do
+            Right ((q, cq), bField, params) -> do
-              let p = V.head payload
+              let prms = case payload of
+                          Just (PayloadJSON pld) -> V.head pld
+                          Nothing -> M.fromList $ second toJSON <$> params -- toJSON is just for reusing the callProc function
                   singular = contentType == CTSingularJSON
                   paramsAsSingleObject = iPreferSingleObjectParameter apiRequest
               row <- H.query () $
-                callProc qi p returnsScalar q cq topLevelRange shouldCount
+                callProc qi prms returnsScalar q cq shouldCount
                          singular paramsAsSingleObject
                          (contentType == CTTextCSV)
-                         (contentType == CTOctetStream) bField
+                         (contentType == CTOctetStream) _isReadOnly bField
-              let (tableTotal, queryTotal, body) =
+                         (pgVersion dbStructure)
-                    fromMaybe (Just 0, 0, "[]") row
+              let (tableTotal, queryTotal, body, jsonHeaders) =
+                    fromMaybe (Just 0, 0, "[]", "[]") row
                   (status, contentRange) = rangeHeader queryTotal tableTotal
-              if singular && queryTotal /= 1
+                  decodedHeaders = first toS $ eitherDecode $ toS jsonHeaders :: Either Text [GucHeader]
-                then do
+              case decodedHeaders of
-                  HT.condemn
+                Left _ -> return gucHeadersError
-                  return $ singularityError (toInteger queryTotal)
+                Right hs ->
-                else return $ responseLBS status [toHeader contentType, contentRange] (toS body)
+                  if singular && queryTotal /= 1
+                    then do
+                      HT.condemn
+                      return $ singularityError (toInteger queryTotal)
+                    else return $ responseLBS status ([toHeader contentType, contentRange] ++ toHeaders hs) (toS body)
 
         (ActionInspect, TargetRoot, Nothing) -> do
           let host = configHost conf
@@ -263,8 +270,8 @@ 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 sd = encodeOpenAPI (M.elems allProcs) (toTableInfo ti) uri' sd (dbPrimaryKeys dbStructure)
+              encodeApi ti sd procs = encodeOpenAPI (M.elems procs) (toTableInfo ti) uri' sd (dbPrimaryKeys dbStructure)
-          body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription
+          body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription <*> H.query schema accessibleProcs
           return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
 
         _ -> return notFound
@@ -298,6 +305,7 @@ app dbStructure conf apiRequest =
       fldNames = fieldNames <$> readReq
       readDbRequest = DbRead <$> readReq
       mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< fldNames)
+      rpcQParams = readRpcRequest apiRequest
       selectQuery = requestToQuery schema False <$> readDbRequest
       mutateQuery = requestToQuery schema False <$> mutateDbRequest
       countQuery = requestToCountQuery schema <$> readDbRequest
@@ -313,7 +321,7 @@ responseContentTypeOrError accepts action = serves contentTypesForRequest accept
         ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
         ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
         ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionInvoke ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
+        ActionInvoke _ ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
         ActionInspect -> [CTOpenAPI, CTApplicationJSON]
         ActionInfo ->    [CTTextCSV]
     serves sProduces cAccepts =

src/PostgREST/Auth.hs

@@ -18,16 +18,12 @@ module PostgREST.Auth (
   , parseJWK
   ) where
 
-import           Protolude        hiding ((&))
+import           Control.Lens.Operators
-import           Control.Lens
+import           Data.Aeson             (Value (..), decode, toJSON)
-import           Data.Aeson              (Value (..), decode, toJSON)
+import qualified Data.HashMap.Strict    as M
-import qualified Data.ByteString.Lazy    as BL
+import           Protolude
-import qualified Data.HashMap.Strict     as M
 
-import           Crypto.JOSE.Compact
+import qualified Crypto.JOSE.Types      as JOSE.Types
-import           Crypto.JOSE.JWK
-import           Crypto.JOSE.JWS
-import           Crypto.JOSE.Types
 import           Crypto.JWT
 
 {-|
@@ -39,30 +35,29 @@ data JWTAttempt = JWTInvalid JWTError
                 deriving (Eq, Show)
 
 {-|
-  Receives the JWT secret (from config) and a JWT and returns a map
+  Receives the JWT secret and audience (from config) and a JWT and returns a map
   of JWT claims.
 -}
-jwtClaims :: Maybe JWK -> BL.ByteString -> IO JWTAttempt
+jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString  -> IO JWTAttempt
-jwtClaims _ "" = return $ JWTClaims M.empty
+jwtClaims _ _ "" = return $ JWTClaims M.empty
-jwtClaims secret payload =
+jwtClaims secret audience payload =
   case secret of
     Nothing -> return JWTMissingSecret
-    Just jwk -> do
+    Just s -> do
-      let validation = defaultJWTValidationSettings
+      let validation = defaultJWTValidationSettings (maybe (const True) (==) audience)
       eJwt <- runExceptT $ do
         jwt <- decodeCompact payload
-        validateJWSJWT validation jwk jwt
+        verifyClaims validation s jwt
-        return jwt
       return $ case eJwt of
-        Left e -> JWTInvalid e
+        Left e    -> JWTInvalid e
-        Right jwt -> JWTClaims . claims2map . jwtClaimsSet $ jwt
+        Right jwt -> JWTClaims . claims2map $ jwt
 
 {-|
   Whether a response from jwtClaims contains a role claim
 -}
 containsRole :: JWTAttempt -> Bool
 containsRole (JWTClaims claims) = M.member "role" claims
-containsRole _ = False
+containsRole _                  = False
 
 {-|
   Internal helper used to turn JWT ClaimSet into something
@@ -72,7 +67,7 @@ claims2map :: ClaimsSet -> M.HashMap Text Value
 claims2map = val2map . toJSON
  where
   val2map (Object o) = o
-  val2map _ = M.empty
+  val2map _          = M.empty
 
 parseJWK :: ByteString -> JWK
 parseJWK str =
@@ -89,4 +84,4 @@ hs256jwk key =
     & jwkUse .~ Just Sig
     & jwkAlg .~ (Just $ JWSAlg HS256)
  where
-  km = OctKeyMaterial (OctKeyParameters Oct (Base64Octets key))
+  km = OctKeyMaterial (OctKeyParameters (JOSE.Types.Base64Octets key))

src/PostgREST/Config.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase, TemplateHaskell #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
 {-|
 Module      : PostgREST.Config
@@ -14,38 +15,49 @@ turned in configurable behaviour if needed.
 Other hardcoded options such as the minimum version number also belong here.
 -}
 module PostgREST.Config ( prettyVersion
+                        , docsVersion
                         , readOptions
                         , corsPolicy
                         , minimumPgVersion
-                        , PgVersion (..)
+                        , pgVersion96
                         , AppConfig (..)
                         )
        where
 
-import           System.IO.Error             (IOError)
+import           PostgREST.Types             (PgVersion(..))
 import           Control.Applicative
-import qualified Data.ByteString             as B
+import           Control.Monad                (fail)
-import qualified Data.ByteString.Char8       as BS
+import           Control.Lens                 (preview)
-import qualified Data.CaseInsensitive        as CI
+import           Crypto.JWT                   (StringOrURI,
-import qualified Data.Configurator           as C
+                                               stringOrUri)
-import qualified Data.Configurator.Parser    as C
+import qualified Data.ByteString              as B
-import           Data.Configurator.Types     (Value(..))
+import qualified Data.ByteString.Char8        as BS
-import           Data.List                   (lookup)
+import qualified Data.CaseInsensitive         as CI
+import qualified Data.Configurator            as C
+import qualified Data.Configurator.Parser     as C
+import           Data.Configurator.Types      as C
+import           Data.List                    (lookup)
 import           Data.Monoid
-import           Data.Scientific             (floatingOrInteger)
+import           Data.Scientific              (floatingOrInteger)
-import           Data.Text                   (strip, intercalate, lines)
+import           Data.String                  (String)
-import           Data.Text.Encoding          (encodeUtf8)
+import           Data.Text                    (dropAround,
-import           Data.Text.IO                (hPutStrLn)
+                                               intercalate, lines,
-import           Data.Version                (versionBranch)
+                                               strip, take)
+import           Data.Text.Encoding           (encodeUtf8)
+import           Data.Text.IO                 (hPutStrLn)
+import           Data.Version                 (versionBranch)
+import           Development.GitRev           (gitHash)
 import           Network.Wai
-import           Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
+import           Network.Wai.Middleware.Cors  (CorsResourcePolicy (..))
-import           Options.Applicative hiding  (str)
+import           Options.Applicative          hiding (str)
-import           Paths_postgrest             (version)
+import           Paths_postgrest              (version)
-import           System.IO                   (hPrint)
+import           Protolude                    hiding (hPutStrLn, take,
+                                               intercalate, (<>))
+import           System.IO                    (hPrint)
+import           System.IO.Error              (IOError)
 import           Text.Heredoc
-import           Text.PrettyPrint.ANSI.Leijen hiding ((<>), (<$>))
+import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
 import qualified Text.PrettyPrint.ANSI.Leijen as L
-import           Protolude hiding            (intercalate, (<>), hPutStrLn)
 
 -- | Config file settings for the server
 data AppConfig = AppConfig {
@@ -58,6 +70,7 @@ data AppConfig = AppConfig {
 
   , configJwtSecret         :: Maybe B.ByteString
   , configJwtSecretIsBase64 :: Bool
+  , configJwtAudience       :: Maybe StringOrURI
 
   , configPool              :: Int
   , configMaxRows           :: Maybe Integer
@@ -90,7 +103,13 @@ corsPolicy req = case lookup "origin" headers of
 
 -- | User friendly version number
 prettyVersion :: Text
-prettyVersion = intercalate "." $ map show $ versionBranch version
+prettyVersion =
+  intercalate "." (map show $ versionBranch version)
+  <> " (" <> take 7 $(gitHash) <> ")"
+
+-- | Version number used in docs
+docsVersion :: Text
+docsVersion = "v" <> dropAround (== '.') (dropAround (/= '.') prettyVersion)
 
 -- | Function to read and parse options from the command line
 readOptions :: IO AppConfig
@@ -102,16 +121,17 @@ readOptions = do
     (C.readConfig =<< C.load [C.Required cfgPath])
     configNotfoundHint
 
-  let (mAppConf, errs) = flip C.runParserA conf $
+  let (mAppConf, errs) = flip C.runParserM conf $
-        AppConfig <$>
+        AppConfig
-            C.key "db-uri"
+          <$> C.key "db-uri"
           <*> C.key "db-anon-role"
-          <*> C.key "server-proxy-uri"
+          <*> (mfilter (/= "") <$> C.key "server-proxy-uri")
           <*> C.key "db-schema"
           <*> (fromMaybe "*4" . mfilter (/= "") <$> C.key "server-host")
           <*> (fromMaybe 3000 . join . fmap coerceInt <$> C.key "server-port")
           <*> (fmap encodeUtf8 . mfilter (/= "") <$> C.key "jwt-secret")
           <*> (fromMaybe False . join . fmap coerceBool <$> C.key "secret-is-base64")
+          <*> parseJwtAudience "jwt-aud"
           <*> (fromMaybe 10 . join . fmap coerceInt <$> C.key "db-pool")
           <*> (join . fmap coerceInt <$> C.key "max-rows")
           <*> (mfilter (/= "") <$> C.key "pre-request")
@@ -124,61 +144,71 @@ readOptions = do
     Just appConf ->
       return appConf
 
- where
+  where
-  coerceInt :: (Read i, Integral i) => Value -> Maybe i
+    parseJwtAudience :: Name -> C.ConfigParserM (Maybe StringOrURI)
-  coerceInt (Number x) = rightToMaybe $ floatingOrInteger x
+    parseJwtAudience k =
-  coerceInt (String x) = readMaybe $ toS x
+      C.key k >>= \case
-  coerceInt _ = Nothing
+        Nothing -> pure Nothing -- no audience in config file
+        Just aud -> case preview stringOrUri (aud :: String) of
+          Nothing -> fail "Invalid Jwt audience. Check your configuration."
+          (Just "") -> pure Nothing
+          aud' -> pure aud'
 
-  coerceBool ::  Value -> Maybe Bool
+    coerceInt :: (Read i, Integral i) => Value -> Maybe i
-  coerceBool (Bool b) = Just b
+    coerceInt (Number x) = rightToMaybe $ floatingOrInteger x
-  coerceBool (String x) = readMaybe $ toS x
+    coerceInt (String x) = readMaybe $ toS x
-  coerceBool _ = Nothing
+    coerceInt _          = Nothing
 
-  opts = info (helper <*> pathParser) $
+    coerceBool ::  Value -> Maybe Bool
-           fullDesc
+    coerceBool (Bool b)   = Just b
-           <> progDesc (
+    coerceBool (String x) = readMaybe $ toS x
-               "PostgREST "
+    coerceBool _          = Nothing
-               <> toS prettyVersion
-               <> " / create a REST API to an existing Postgres database"
-             )
-           <> footerDoc (Just $
-               text "Example Config File:"
-               L.<> nest 2 (hardline L.<> exampleCfg)
-             )
 
-  parserPrefs = prefs showHelpOnError
+    opts = info (helper <*> pathParser) $
+             fullDesc
+             <> progDesc (
+                 "PostgREST "
+                 <> toS prettyVersion
+                 <> " / create a REST API to an existing Postgres database"
+               )
+             <> footerDoc (Just $
+                 text "Example Config File:"
+                 L.<> nest 2 (hardline L.<> exampleCfg)
+               )
 
-  configNotfoundHint :: IOError -> IO a
+    parserPrefs = prefs showHelpOnError
-  configNotfoundHint e = do
-    hPutStrLn stderr $
-      "Cannot open config file:\n\t" <> show e
-    exitFailure
 
-  exampleCfg :: Doc
+    configNotfoundHint :: IOError -> IO a
-  exampleCfg = vsep . map (text . toS) . lines $
+    configNotfoundHint e = do
-    [str|db-uri = "postgres://user:pass@localhost:5432/dbname"
+      hPutStrLn stderr $
-        |db-schema = "public"
+        "Cannot open config file:\n\t" <> show e
-        |db-anon-role = "postgres"
+      exitFailure
-        |db-pool = 10
+
-        |
+    exampleCfg :: Doc
-        |server-host = "*4"
+    exampleCfg = vsep . map (text . toS) . lines $
-        |server-port = 3000
+      [str|db-uri = "postgres://user:pass@localhost:5432/dbname"
-        |
+          |db-schema = "public"
-        |## base url for swagger output
+          |db-anon-role = "postgres"
-        |# server-proxy-uri = ""
+          |db-pool = 10
-        |
+          |
-        |## choose a secret to enable JWT auth
+          |server-host = "*4"
-        |## (use "@filename" to load from separate file)
+          |server-port = 3000
-        |# jwt-secret = "foo"
+          |
-        |# secret-is-base64 = false
+          |## base url for swagger output
-        |
+          |# server-proxy-uri = ""
-        |## limit rows in response
+          |
-        |# max-rows = 1000
+          |## choose a secret to enable JWT auth
-        |
+          |## (use "@filename" to load from separate file)
-        |## stored proc to exec immediately after auth
+          |# jwt-secret = "foo"
-        |# pre-request = "stored_proc_name"
+          |# secret-is-base64 = false
-        |]
+          |# jwt-aud = "your_audience_claim"
+          |
+          |## limit rows in response
+          |# max-rows = 1000
+          |
+          |## stored proc to exec immediately after auth
+          |# pre-request = "stored_proc_name"
+          |]
 
 pathParser :: Parser FilePath
 pathParser =
@@ -186,11 +216,9 @@ pathParser =
     metavar "FILENAME" <>
     help "Path to configuration file"
 
-data PgVersion = PgVersion {
-  pgvNum  :: Int32
-, pgvName :: Text
-}
-
 -- | Tells the minimum PostgreSQL version required by this version of PostgREST
 minimumPgVersion :: PgVersion
 minimumPgVersion = PgVersion 90300 "9.3"
+
+pgVersion96 :: PgVersion
+pgVersion96 = PgVersion 90600 "9.6"

src/PostgREST/DbRequestBuilder.hs

@@ -3,6 +3,7 @@
 module PostgREST.DbRequestBuilder (
   readRequest
 , mutateRequest
+, readRpcRequest
 , fieldNames
 ) where
 
@@ -30,7 +31,6 @@ import           PostgREST.ApiRequest   ( ApiRequest(..)
 import           PostgREST.Error           (apiRequestError)
 import           PostgREST.Parsers
 import           PostgREST.RangeQuery      (NonnegRange, restrictRange)
-import           PostgREST.QueryBuilder (getJoinFilters, sourceCTEName)
 import           PostgREST.Types
 
 import           Protolude                hiding (from, dropWhile, drop)
@@ -72,10 +72,10 @@ readRequest maxRows allRels allProcs apiRequest  =
 
     relations :: [Relation]
     relations = case action of
-      ActionCreate -> fakeSourceRelations ++ allRels
+      ActionCreate   -> fakeSourceRelations ++ allRels
-      ActionUpdate -> fakeSourceRelations ++ allRels
+      ActionUpdate   -> fakeSourceRelations ++ allRels
-      ActionDelete -> fakeSourceRelations ++ allRels
+      ActionDelete   -> fakeSourceRelations ++ allRels
-      ActionInvoke -> fakeSourceRelations ++ allRels
+      ActionInvoke _ -> fakeSourceRelations ++ allRels
       _       -> allRels
       where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation
 
@@ -193,7 +193,7 @@ addJoinFilters :: Schema -> ReadRequest -> Either ApiRequestError ReadRequest
 addJoinFilters schema (Node node@(query, nodeProps@(_, relation, _, _)) forest) =
   case relation of
     Just Relation{relType=Root} -> Node node  <$> updatedForest -- this is the root node
-    Just Relation{relType=Parent} -> Node node <$> updatedForest
+    Just rel@Relation{relType=Parent} -> Node (augmentQuery rel, nodeProps) <$> updatedForest
     Just rel@Relation{relType=Child} -> Node (augmentQuery rel, nodeProps) <$> updatedForest
     Just rel@Relation{relType=Many, relLTable=(Just linkTable)} ->
       let rq = augmentQuery rel in
@@ -204,6 +204,21 @@ addJoinFilters schema (Node node@(query, nodeProps@(_, relation, _, _)) forest)
     augmentQuery rel = foldr addFilterToReadQuery query (getJoinFilters rel)
     addFilterToReadQuery flt rq@Select{where_=lf} = rq{where_=addFilterToLogicForest flt lf}::ReadQuery
 
+getJoinFilters :: Relation -> [Filter]
+getJoinFilters (Relation t cols ft fcs typ lt lc1 lc2) =
+  case typ of
+    Child  -> zipWith (toFilter tN ftN) cols fcs
+    Parent -> zipWith (toFilter tN ftN) cols fcs
+    Many   -> zipWith (toFilter tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
+    Root   -> undefined --error "undefined getJoinFilters"
+  where
+    s = if typ == Parent then "" else tableSchema t
+    tN = tableName t
+    ftN = tableName ft
+    ltN = fromMaybe "" (tableName <$> lt)
+    toFilter :: Text -> Text -> Column -> Column -> Filter
+    toFilter tb ftb c fc = Filter (colName c, Nothing) (OpExpr False (Join (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}})))
+
 addFiltersOrdersRanges :: ApiRequest -> Either ApiRequestError (ReadRequest -> ReadRequest)
 addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
     flip (foldr addFilter) <$> filters,
@@ -222,9 +237,11 @@ addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
     logicForest = mapM pRequestLogicTree logFrst
     action = iAction apiRequest
     -- there can be no filters on the root table when we are doing insert/update/delete
-    (flts, logFrst)
+    (flts, logFrst) =
-      | action == ActionRead || action == ActionInvoke = (iFilters apiRequest, iLogic apiRequest)
+      case action of
-      | otherwise = join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
+        ActionInvoke _ -> (iFilters apiRequest, iLogic apiRequest)
+        ActionRead     -> (iFilters apiRequest, iLogic apiRequest)
+        _              -> join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
     orders :: Either ApiRequestError [(EmbedPath, [OrderTerm])]
     orders = mapM pRequestOrder $ iOrder apiRequest
     ranges :: Either ApiRequestError [(EmbedPath, NonnegRange)]
@@ -310,6 +327,11 @@ mutateRequest apiRequest fldNames = mapLeft apiRequestError $
     (mutateFilters, logicFilters) = join (***) onlyRoot (iFilters apiRequest, iLogic apiRequest)
     onlyRoot = filter (not . ( "." `isInfixOf` ) . fst)
 
+readRpcRequest :: ApiRequest -> Either Response [RpcQParam]
+readRpcRequest apiRequest = mapLeft apiRequestError rpcQParams
+  where
+    rpcQParams = mapM pRequestRpcQParam $ iRpcQParams apiRequest
+
 fieldNames :: ReadRequest -> [FieldName]
 fieldNames (Node (sel, _) forest) =
   map (fst . view _1) (select sel) ++ map colName fks

src/PostgREST/DbStructure.hs

@@ -6,7 +6,9 @@
 module PostgREST.DbStructure (
   getDbStructure
 , accessibleTables
+, accessibleProcs
 , schemaDescription
+, getPgVersion
 ) where
 
 import qualified Hasql.Decoders                as HD
@@ -18,7 +20,7 @@ import qualified Data.HashMap.Strict           as M
 import           Data.List                     (elemIndex)
 import           Data.Maybe                    (fromJust)
 import           Data.Text                     (split, strip,
-                                                breakOn, dropAround)
+                                                breakOn, dropAround, splitOn)
 import qualified Data.Text                     as T
 import qualified Hasql.Session                 as H
 import           PostgREST.Types
@@ -28,14 +30,14 @@ import           GHC.Exts                      (groupWith)
 import           Protolude
 import           Unsafe (unsafeHead)
 
-getDbStructure :: Schema -> H.Session DbStructure
+getDbStructure :: Schema -> PgVersion -> H.Session DbStructure
-getDbStructure schema = do
+getDbStructure schema pgVer = do
   tabs <- H.query () allTables
-  cols <- H.query () $ allColumns tabs
+  cols <- H.query schema $ allColumns tabs
   syns <- H.query () $ allSynonyms cols
   rels <- H.query () $ allRelations tabs cols
   keys <- H.query () $ allPrimaryKeys tabs
-  procs <- H.query schema accessibleProcs
+  procs <- H.query schema allProcs
 
   let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels
       cols' = addForeignKeys rels' cols
@@ -47,6 +49,7 @@ getDbStructure schema = do
     , dbRelations = rels'
     , dbPrimaryKeys = keys'
     , dbProcs = procs
+    , pgVersion = pgVer
     }
 
 decodeTables :: HD.Result [Table]
@@ -100,59 +103,65 @@ decodeSynonyms cols =
     <*> HD.value HD.text <*> HD.value HD.text
     <*> HD.value HD.text <*> HD.value HD.text
 
+decodeProcs :: HD.Result (M.HashMap Text ProcDescription)
+decodeProcs =
+  M.fromList . map addName <$> HD.rowsList tblRow
+  where
+    tblRow = ProcDescription
+              <$> HD.value HD.text
+              <*> HD.nullableValue 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)
+
+    addName :: ProcDescription -> (Text, ProcDescription)
+    addName pd = (pdName pd, pd)
+
+    parseArgs :: Text -> [PgArg]
+    parseArgs = mapMaybe parseArg . filter (not . isPrefixOf "OUT" . toS) . map strip . split (==',')
+
+    parseArg :: Text -> Maybe PgArg
+    parseArg a =
+      let arg = lastDef "" $ splitOn "INOUT " a
+          (body, def) = breakOn " DEFAULT " arg
+          (name, typ) = breakOn " " body in
+      if T.null typ
+         then Nothing
+         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' -> if name == "record" -- Only pg pseudo type that is a row type is 'record'
+                   then Composite qi
+                   else Scalar qi
+          _   -> Scalar qi -- 'b'ase, 'd'omain, 'e'num, 'r'ange
+
+    parseVolatility :: Char -> ProcVolatility
+    parseVolatility v | v == 'i' = Immutable
+                      | v == 's' = Stable
+                      | otherwise = Volatile -- only 'v' can happen here
+
+allProcs :: H.Query Schema (M.HashMap Text ProcDescription)
+allProcs = H.statement (toS procsSqlQuery) (HE.value HE.text) decodeProcs True
+
 accessibleProcs :: H.Query Schema (M.HashMap Text ProcDescription)
-accessibleProcs =
+accessibleProcs = H.statement (toS sql) (HE.value HE.text) decodeProcs True
-  H.statement sql (HE.value HE.text)
+  where
-    (M.fromList . map addName <$>
+    sql = procsSqlQuery <> " AND has_function_privilege(p.oid, 'execute')"
-      HD.rowsList (
-        ProcDescription <$> HD.value HD.text
-                        <*> HD.nullableValue 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)
 
-  parseArgs :: Text -> [PgArg]
+procsSqlQuery :: SqlQuery
-  parseArgs = mapMaybe (parseArg . strip) . split (==',')
+procsSqlQuery = [q|
-
-  parseArg :: Text -> Maybe PgArg
-  parseArg a =
-    let (body, def) = breakOn " DEFAULT " a
-        (name, typ) = breakOn " " body in
-    if T.null typ
-       then Nothing
-       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' -> if name == "record" -- Only pg pseudo type that is a row type is 'record'
-                 then Composite qi
-                 else Scalar qi
-        _   -> 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",
          d.description as "proc_description",
          pg_get_function_arguments(p.oid) as "args",
@@ -167,11 +176,12 @@ accessibleProcs =
     JOIN pg_namespace tn ON tn.oid = t.typnamespace
     LEFT JOIN pg_class comp ON comp.oid = t.typrelid
     LEFT JOIN pg_catalog.pg_description as d on d.objoid = p.oid
-  WHERE  pn.nspname = $1|]
+  WHERE  pn.nspname = $1
+|]
 
 schemaDescription :: H.Query Schema (Maybe Text)
 schemaDescription =
-    H.statement sql (HE.value HE.text) (HD.singleRow $ HD.nullableValue HD.text) True
+    H.statement sql (HE.value HE.text) (join <$> HD.maybeRow (HD.nullableValue HD.text)) True
   where
     sql = [q|
       select
@@ -311,9 +321,9 @@ allTables =
     GROUP BY table_schema, table_name, insertable
     ORDER BY table_schema, table_name |]
 
-allColumns :: [Table] -> H.Query () [Column]
+allColumns :: [Table] -> H.Query Schema [Column]
 allColumns tabs =
-  H.statement sql HE.unit (decodeColumns tabs) True
+  H.statement sql (HE.value HE.text) (decodeColumns tabs) True
  where
   sql = [q|
     SELECT DISTINCT
@@ -331,9 +341,35 @@ allColumns tabs =
         array_to_string(enum_info.vals, ',') AS enum
     FROM (
         /*
-        -- CTE based on information_schema.columns to remove the owner filter
+        -- CTE based on pg_catalog to get only Primary and Foreign key columns outside api schema
         */
-        WITH columns AS (
+        WITH key_columns AS (
+             SELECT
+               r.oid AS r_oid,
+               c.oid AS c_oid,
+               n.nspname,
+               c.relname,
+               r.conname,
+               r.contype,
+               unnest(r.conkey) AS conkey
+             FROM
+               pg_catalog.pg_constraint r,
+               pg_catalog.pg_class c,
+               pg_catalog.pg_namespace n
+             WHERE
+               r.contype IN ('f', 'p')
+               AND c.relkind IN ('r', 'v', 'f', 'mv')
+               AND r.conrelid = c.oid
+               AND c.relnamespace = n.oid
+               AND n.nspname NOT IN ('pg_catalog', 'information_schema', $1)
+        ),
+        /*
+        -- CTE based on information_schema.columns
+        -- changed:
+        -- remove the owner filter
+        -- limit columns to the ones in the api schema or PK/FK columns
+        */
+        columns AS (
             SELECT current_database()::information_schema.sql_identifier AS table_catalog,
                 nc.nspname::information_schema.sql_identifier AS table_schema,
                 c.relname::information_schema.sql_identifier AS table_name,
@@ -411,6 +447,7 @@ allColumns tabs =
                     ELSE 'NO'::text
                 END::information_schema.yes_or_no AS is_updatable
             FROM pg_attribute a
+               LEFT JOIN key_columns kc ON kc.conkey = a.attnum AND kc.c_oid = a.attrelid
                LEFT JOIN pg_catalog.pg_description AS d ON d.objoid = a.attrelid and d.objsubid = a.attnum
                LEFT JOIN pg_attrdef ad ON a.attrelid = ad.adrelid AND a.attnum = ad.adnum
                JOIN (pg_class c
@@ -421,7 +458,12 @@ allColumns tabs =
                JOIN pg_namespace nbt ON bt.typnamespace = nbt.oid) ON t.typtype = 'd'::"char" AND t.typbasetype = bt.oid
                LEFT JOIN (pg_collation co
                JOIN pg_namespace nco ON co.collnamespace = nco.oid) ON a.attcollation = co.oid AND (nco.nspname <> 'pg_catalog'::name OR co.collname <> 'default'::name)
-            WHERE NOT pg_is_other_temp_schema(nc.oid) AND a.attnum > 0 AND NOT a.attisdropped AND (c.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char"]))
+            WHERE
+                NOT pg_is_other_temp_schema(nc.oid)
+                AND a.attnum > 0
+                AND NOT a.attisdropped
+                AND (c.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char"]))
+                AND (nc.nspname = $1 OR kc.r_oid IS NOT NULL) /*--filter only columns that are FK/PK or in the api schema */
               /*--AND (pg_has_role(c.relowner, 'USAGE'::text) OR has_column_privilege(c.oid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/
         )
         SELECT
@@ -698,3 +740,9 @@ synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
     col1 = findCol s1 t1 c1
     col2 = findCol s2 t2 c2
     findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols
+
+getPgVersion :: H.Session PgVersion
+getPgVersion = H.query () $ H.statement sql HE.unit versionRow False
+  where
+    sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
+    versionRow = HD.singleRow $ PgVersion <$> HD.value HD.int4 <*> HD.value HD.text

src/PostgREST/Error.hs

@@ -10,6 +10,7 @@ module PostgREST.Error (
 , binaryFieldError
 , connectionLostError
 , encodeError
+, gucHeadersError
 ) where
 
 import           Protolude
@@ -22,6 +23,7 @@ import           Network.HTTP.Types.Header
 import qualified Network.HTTP.Types.Status as HT
 import           Network.Wai               (Response, responseLBS)
 import           PostgREST.Types
+import           Text.Read                 (readMaybe)
 
 apiRequestError :: ApiRequestError -> Response
 apiRequestError err =
@@ -78,6 +80,11 @@ binaryFieldError =
   simpleError HT.status406 [] (toS (toMime CTOctetStream) <>
   " requested but a single column was not selected")
 
+gucHeadersError :: Response
+gucHeadersError =
+ simpleError HT.status500 []
+ "response.headers guc must be a JSON array composed of objects with a single key and a string value"
+
 connectionLostError :: Response
 connectionLostError =
   simpleError HT.status503 [] "Database connection lost, retrying the connection."
@@ -109,11 +116,17 @@ instance JSON.ToJSON P.UsageError where
   toJSON (P.SessionError e) = JSON.toJSON e -- H.Error
 
 instance JSON.ToJSON H.Error where
-  toJSON (H.ResultError (H.ServerError c m d h)) = JSON.object [
+  toJSON (H.ResultError (H.ServerError c m d h)) = case toS c of
-    "code" .= (toS c::Text),
+    'P':'T':_ ->
-    "message" .= (toS m::Text),
+      JSON.object [
-    "details" .= (fmap toS d::Maybe Text),
+        "details" .= (fmap toS d::Maybe Text),
-    "hint" .= (fmap toS h::Maybe Text)]
+        "hint" .= (fmap toS h::Maybe Text)]
+    _ ->
+      JSON.object [
+        "code" .= (toS c::Text),
+        "message" .= (toS m::Text),
+        "details" .= (fmap toS d::Maybe Text),
+        "hint" .= (fmap toS h::Maybe Text)]
   toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [
     "message" .= (m::Text)]
   toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [
@@ -138,7 +151,7 @@ instance JSON.ToJSON H.Error where
 
 httpStatus :: Bool -> P.UsageError -> HT.Status
 httpStatus _ (P.ConnectionError _) = HT.status503
-httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
+httpStatus authed (P.SessionError (H.ResultError (H.ServerError c m _ _))) =
   case toS c of
     '0':'8':_ -> HT.status503 -- pg connection err
     '0':'9':_ -> HT.status500 -- triggered action exception
@@ -166,6 +179,7 @@ httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
     "42883"   -> HT.status404 -- undefined function
     "42P01"   -> HT.status404 -- undefined table
     "42501"   -> if authed then HT.status403 else HT.status401 -- insufficient privilege
+    'P':'T':n -> fromMaybe HT.status500 (HT.mkStatus <$> readMaybe n <*> pure m)
     _         -> HT.status400
 httpStatus _ (P.SessionError (H.ResultError _)) = HT.status500
 httpStatus _ (P.SessionError (H.ClientError _)) = HT.status503

src/PostgREST/OpenAPI.hs

@@ -22,7 +22,7 @@ import           Protolude hiding              ((&), Proxy, get, intercalate, dr
 import           Data.Swagger
 
 import           PostgREST.ApiRequest        (ContentType(..))
-import           PostgREST.Config            (prettyVersion)
+import           PostgREST.Config            (prettyVersion, docsVersion)
 import           PostgREST.Types             (Table(..), Column(..), PgArg(..), ForeignKey(..),
                                               PrimaryKey(..), Proxy(..), ProcDescription(..), toMime)
 
@@ -260,7 +260,7 @@ postgrestSpec pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
       & description ?~ d)
   & externalDocs ?~ ((mempty :: ExternalDocs)
     & description ?~ "PostgREST Documentation"
-    & url .~ URL "https://postgrest.com/en/latest/api.html")
+    & url .~ URL ("https://postgrest.com/en/" <> docsVersion <> "/api.html"))
   & host .~ h'
   & definitions .~ fromList (map (makeTableDef pks) ti)
   & parameters .~ fromList (makeParamDefs ti)

src/PostgREST/Parsers.hs

@@ -1,6 +1,6 @@
 module PostgREST.Parsers where
 
-import           Protolude                     hiding (try, intercalate, replace)
+import           Protolude                     hiding (try, intercalate, replace, option)
 import           Control.Monad                 ((>>))
 import           Data.Foldable                 (foldl1)
 import qualified Data.HashMap.Strict           as M
@@ -21,7 +21,7 @@ pRequestFilter :: (Text, Text) -> Either ApiRequestError (EmbedPath, Filter)
 pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper)
   where
     treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k
-    oper = parse (pOperation pVText pVTextL) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
+    oper = parse (pOpExpr pSingleVal pListVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v
     path = fst <$> treePath
     fld = snd <$> treePath
 
@@ -44,9 +44,15 @@ pRequestLogicTree (k, v) = mapError $ (,) <$> embedPath <*> logicTree
     path = parse pLogicPath ("failed to parser logic path (" ++ toS k ++ ")") $ toS k
     embedPath = fst <$> path
     op = snd <$> path
-    -- Concat op and v to make pLogicTree argument regular, in the form of "op(.,.)"
+    -- Concat op and v to make pLogicTree argument regular, in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)"
     logicTree = join $ parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") . toS <$> ((<>) <$> op <*> pure v)
 
+pRequestRpcQParam :: (Text, Text) -> Either ApiRequestError RpcQParam
+pRequestRpcQParam (k, v) = mapError $ (,) <$> name <*> val
+  where
+    name = parse pFieldName ("failed to parse rpc arg name (" ++ toS k ++ ")") $ toS k
+    val = toS <$> parse (many anyChar) ("failed to parse rpc arg value (" ++ toS v ++ ")") v
+
 ws :: Parser Text
 ws = toS <$> many (oneOf " \t")
 
@@ -78,7 +84,7 @@ pFieldForest :: Parser [Tree SelectItem]
 pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
 
 pFieldTree :: Parser (Tree SelectItem)
-pFieldTree =  try (Node <$> pRelationSelect <*> between (char '{') (char '}') pFieldForest)
+pFieldTree =  try (Node <$> pRelationSelect <*> between (char '{') (char '}') pFieldForest) -- TODO: "{}" deprecated
           <|> try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest)
           <|> Node <$> pFieldSelect <*> pure []
 
@@ -96,7 +102,6 @@ pFieldName = do
     dash :: Parser Char
     dash = isDash *> pure '-'
 
-
 pJsonPathStep :: Parser Text
 pJsonPathStep = toS <$> try (string "->" *> pFieldName)
 
@@ -131,26 +136,33 @@ pFieldSelect = lexeme $
     s <- pStar
     return ((s, Nothing), Nothing, Nothing, Nothing)
 
-pOperation :: Parser Operand -> Parser Operand -> Parser Operation
+pOpExpr :: Parser SingleVal -> Parser ListVal -> Parser OpExpr
-pOperation parserVText parserVTextL = try ( string "not" *> pDelimiter *> (Operation True <$> pExpr)) <|> Operation False <$> pExpr
+pOpExpr pSVal pLVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
   where
-    pExpr :: Parser (Operator, Operand)
+    pOperation :: Parser Operation
-    pExpr =
+    pOperation =
-          ((,) <$> (toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys notInOps)) <*> parserVText)
+          Op . toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys ops) <*> pSVal
-      <|> ((,) <$> (toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys inOps)) <*> parserVTextL)
+      <|> In <$> (string "in" *> pDelimiter *> pLVal)
+      <|> pFts
       <?> "operator (eq, gt, ...)"
-    inOps = M.filterWithKey (const . flip elem ["in", "notin"]) operators
-    notInOps = M.difference operators inOps
 
-pVText :: Parser Operand
+    pFts = do
-pVText = VText . toS <$> many anyChar
+      op   <- foldl1 (<|>) (try . string . toS <$> ftsOps)
+      lang <- optionMaybe $ try (between (char '(') (char ')') (many (letter <|> digit <|> oneOf "_")))
+      pDelimiter >> Fts (toS op) (toS <$> lang) <$> pSVal
 
-pVTextL :: Parser Operand
+    ops = M.filterWithKey (const . flip notElem ("in":ftsOps)) operators
-pVTextL =     VTextL <$> try (lexeme (char '(') *> pVTextLElement `sepBy1` char ',' <* lexeme (char ')'))
+    ftsOps = M.keys ftsOperators
-          <|> VTextL <$> lexeme pVTextLElement `sepBy1` char ','
 
-pVTextLElement :: Parser Text
+pSingleVal :: Parser SingleVal
-pVTextLElement = try pQuotedValue <|> (toS <$> many (noneOf ",)"))
+pSingleVal = toS <$> many anyChar
+
+pListVal :: Parser ListVal
+pListVal =    try (lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')'))
+          <|> lexeme pListElement `sepBy1` char ',' -- TODO: "in.3,4,5" deprecated, parens e.g. "in.(3,4,5)" should be used
+
+pListElement :: Parser Text
+pListElement = try pQuotedValue <|> (toS <$> many (noneOf ",)"))
 
 pQuotedValue :: Parser Text
 pQuotedValue = toS <$> (char '"' *> many (noneOf "\"") <* char '"' <* notFollowedBy (noneOf ",)"))
@@ -182,7 +194,7 @@ pLogicTree = Stmnt <$> try pLogicFilter
              <|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree `sepBy1` lexeme (char ',') <* lexeme (char ')'))
   where
     pLogicFilter :: Parser Filter
-    pLogicFilter = Filter <$> pField <* pDelimiter <*> pOperation pLogicVText pLogicVTextL
+    pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal pLogicListVal
     pNot :: Parser Bool
     pNot = try (string "not" *> pDelimiter *> pure True)
            <|> pure False
@@ -192,9 +204,10 @@ pLogicTree = Stmnt <$> try pLogicFilter
                <|> string "or" *> pure Or
                <?> "logic operator (and, or)"
 
-pLogicVText :: Parser Operand
+pLogicSingleVal :: Parser SingleVal
-pLogicVText = VText <$> (try pQuotedValue <|> try pPgArray <|> (toS <$> many (noneOf ",)")))
+pLogicSingleVal = try pQuotedValue <|> try pPgArray <|> (toS <$> many (noneOf ",)"))
   where
+    -- TODO: "{}" deprecated, after removal pPgArray can be removed
     pPgArray :: Parser Text
     pPgArray =  do
       a <- string "{"
@@ -202,8 +215,8 @@ pLogicVText = VText <$> (try pQuotedValue <|> try pPgArray <|> (toS <$> many (no
       c <- string "}"
       toS <$> pure (a ++ b ++ c)
 
-pLogicVTextL :: Parser Operand
+pLogicListVal :: Parser ListVal
-pLogicVTextL = VTextL <$> (lexeme (char '(') *> pVTextLElement `sepBy1` char ',' <* lexeme (char ')'))
+pLogicListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')
 
 pLogicPath :: Parser (EmbedPath, Text)
 pLogicPath = do

src/PostgREST/QueryBuilder.hs

@@ -14,12 +14,10 @@ module PostgREST.QueryBuilder (
     callProc
   , createReadStatement
   , createWriteStatement
-  , getJoinFilters
   , pgFmtIdent
   , pgFmtLit
   , requestToQuery
   , requestToCountQuery
-  , sourceCTEName
   , unquoted
   , ResultsWithCount
   , pgFmtEnvVar
@@ -31,6 +29,7 @@ import qualified Hasql.Decoders          as HD
 
 import qualified Data.Aeson              as JSON
 
+import           PostgREST.Config        (pgVersion96)
 import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset, allRange)
 import           Data.Functor.Contravariant (contramap)
 import qualified Data.HashMap.Strict     as HM
@@ -142,38 +141,43 @@ createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys
     | wantSingle = asJsonSingleF
     | otherwise = asJsonF
 
-type ProcResults = (Maybe Int64, Int64, ByteString)
+type ProcResults = (Maybe Int64, Int64, ByteString, ByteString)
-callProc :: QualifiedIdentifier -> JSON.Object -> Bool -> SqlQuery -> SqlQuery -> NonnegRange ->
+callProc :: QualifiedIdentifier -> JSON.Object -> Bool -> SqlQuery -> SqlQuery -> Bool ->
-  Bool -> Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> H.Query () (Maybe ProcResults)
+  Bool -> Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> H.Query () (Maybe ProcResults)
-callProc qi params returnsScalar selectQuery countQuery _ countTotal isSingle paramsAsJson asCsv asBinary binaryField =
+callProc qi params returnsScalar selectQuery countQuery countTotal isSingle paramsAsJson asCsv asBinary isReadOnly binaryField pgVer =
   unicodeStatement sql HE.unit decodeProc True
   where
     sql =
      if returnsScalar then [qc|
-       WITH {sourceCTEName} AS ({_callSql})
+       WITH {sourceCTEName} AS (select {fromQi qi}({_args}))
        SELECT
          {countResultF} AS total_result_set,
          1 AS page_total,
-         {scalarBodyF} as body
+         {scalarBodyF} AS body,
+         {responseHeaders} AS response_headers
        FROM ({selectQuery}) _postgrest_t;|]
      else [qc|
-       WITH {sourceCTEName} AS ({_callSql})
+       WITH {sourceCTEName} AS (select * from {fromQi qi}({_args}))
        SELECT
          {countResultF} AS total_result_set,
          pg_catalog.count(_postgrest_t) AS page_total,
-         {bodyF} as body
+         {bodyF} AS body,
+         {responseHeaders} AS response_headers
        FROM ({selectQuery}) _postgrest_t;|]
 
     countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
-    _args = if paramsAsJson
+    _args = if paramsAsJson && not isReadOnly
                 then insertableValueWithType "json" $ JSON.Object params
                 else intercalate "," $ map _assignment (HM.toList params)
     _procName = qiName qi
     _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
-    _callSql = [qc|select * from {fromQi qi}({_args}) |] :: Text
+    responseHeaders =
+      if pgVer >= pgVersion96
+        then "coalesce(nullif(current_setting('response.headers', true), ''), '[]')" :: Text -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15
+        else "'[]'" :: Text
     decodeProc = HD.maybeRow procRow
-    procRow = (,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
+    procRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
-                   <*> HD.value HD.bytea
+                    <*> HD.value HD.bytea <*> HD.value HD.bytea
     scalarBodyF
      | asBinary = asBinaryF _procName
      | otherwise = "(row_to_json(_postgrest_t)->" <> pgFmtLit _procName <> ")::character varying"
@@ -208,7 +212,7 @@ requestToCountQuery schema (DbRead (Node (Select _ _ logicForest _ _, (mainTbl,
    qi = removeSourceCTESchema schema mainTbl
    -- all foreing key filters are root nodes(see addFilterToLogicForest), only those are filtered
    nonFKRoot :: LogicTree -> Bool
-   nonFKRoot (Stmnt (Filter _ Operation{expr=(_, VForeignKey _ _)})) = False
+   nonFKRoot (Stmnt (Filter _ (OpExpr _ (Join _ _)))) = False
    nonFKRoot (Stmnt _) = True
    nonFKRoot Expr{} = True
    filteredLogic = filter nonFKRoot logicForest
@@ -245,24 +249,21 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest
     getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (j,sel:s)
       where
         sel = "COALESCE(("
-           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
+           <> "SELECT json_agg(" <> pgFmtIdent table <> ".*) "
            <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
            <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
            where subquery = requestToQuery schema False (DbRead (Node n forst))
-    getQueryParts (Node n@(_, (name, Just r@Relation{relType=Parent,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (joi:j,sel:s)
+    getQueryParts (Node n@(_, (name, Just Relation{relType=Parent,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (joi:j,sel:s)
       where
-        node_name = fromMaybe name alias
+        aliasOrName = fromMaybe name alias
-        local_table_name = table <> "_" <> node_name
+        localTableName = pgFmtIdent $ table <> "_" <> aliasOrName
-        replaceTableName localTableName (Filter a (Operation b (c, VForeignKey (QualifiedIdentifier "" _) d))) = Filter a (Operation b (c, VForeignKey (QualifiedIdentifier "" localTableName) d))
+        sel = "row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName
-        replaceTableName _ x = x
+        joi = " LEFT JOIN LATERAL( " <> subquery <> " ) AS " <> localTableName <> " ON TRUE "
-        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 (pgFmtFilter qi . replaceTableName local_table_name) (getJoinFilters 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
         sel = "COALESCE (("
-           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
+           <> "SELECT json_agg(" <> pgFmtIdent table <> ".*) "
            <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
            <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
            where subquery = requestToQuery schema False (DbRead (Node n forst))
@@ -309,9 +310,6 @@ requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) =
       ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
       ]
 
-sourceCTEName :: SqlFragment
-sourceCTEName = "pg_source"
-
 removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
 removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl
 
@@ -338,7 +336,7 @@ asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
     asCsvBodyF = "coalesce(string_agg(substring(_postgrest_t::text, 2, length(_postgrest_t::text) - 2), '\n'), '')"
 
 asJsonF :: SqlFragment
-asJsonF = "coalesce(array_to_json(array_agg(row_to_json(_postgrest_t))), '[]')::character varying"
+asJsonF = "coalesce(json_agg(_postgrest_t), '[]')::character varying"
 
 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 "
@@ -372,21 +370,6 @@ fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
     n = qiName t
     s = qiSchema t
 
-getJoinFilters :: Relation -> [Filter]
-getJoinFilters (Relation t cols ft fcs typ lt lc1 lc2) =
-  case typ of
-    Child  -> zipWith (toFilter tN ftN) cols fcs
-    Parent -> zipWith (toFilter tN ftN) cols fcs
-    Many   -> zipWith (toFilter tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
-    Root   -> undefined --error "undefined getJoinFilters"
-  where
-    s = if typ == Parent then "" else tableSchema t
-    tN = tableName t
-    ftN = tableName ft
-    ltN = fromMaybe "" (tableName <$> lt)
-    toFilter :: Text -> Text -> Column -> Column -> Filter
-    toFilter tb ftb c fc = Filter (colName c, Nothing) (Operation False ("=", 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
 
@@ -413,43 +396,43 @@ pgFmtSelectItem table (f@(_, jp), Nothing, alias, _) = pgFmtField table f <> pgF
 pgFmtSelectItem table (f@(_, jp), Just cast, alias, _) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs jp alias
 
 pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment
-pgFmtFilter table (Filter fld (Operation hasNot_ ex)) = notOp <> " " <> case ex of
+pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
-   (op, VText val) -> pgFmtFieldOp op <> " " <> case op of
+   Op op val  -> pgFmtFieldOp op <> " " <> case op of
-     "like"  -> unknownLiteral (T.map star val)
+     "like"   -> unknownLiteral (T.map star val)
-     "ilike" -> unknownLiteral (T.map star val)
+     "ilike"  -> unknownLiteral (T.map star val)
-     -- TODO: The '@@' was deprecated, remove in v0.5.0.0
+     "is"     -> whiteList val
-     "@@"    -> "to_tsquery(" <> unknownLiteral val <> ") "
+     _        -> unknownLiteral val
-     "fts"   -> "to_tsquery(" <> unknownLiteral val <> ") "
+
-     "is"    -> whiteList val
+   In vals -> pgFmtField table fld <> " " <>
-     "isnot" -> whiteList val
+    let emptyValForIn = "= any('{}') " in -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')"
-     _       -> unknownLiteral val
+    case ((&&) (length vals == 1) . T.null) <$> headMay vals of
-   (op, VTextL vals) -> pgFmtIn op vals -- in and notin
+      Just False -> sqlOperator "in" <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "
-   (op, VForeignKey fQi (ForeignKey Column{colTable=Table{tableName=fTableName}, colName=fColName})) ->
+      Just True  -> emptyValForIn
-     pgFmtField fQi fld <> " " <> sqlOperator op <> " " <> pgFmtColumn (removeSourceCTESchema (qiSchema fQi) fTableName) fColName
+      Nothing    -> emptyValForIn
+
+   Fts op lang val ->
+     pgFmtFieldOp op
+       <> "("
+       <> maybe "" ((<> ", ") . pgFmtLit) lang
+       <> unknownLiteral val
+       <> ") "
+
+   Join fQi (ForeignKey Column{colTable=Table{tableName=fTableName}, colName=fColName}) ->
+     pgFmtField fQi fld <> " = " <> pgFmtColumn (removeSourceCTESchema (qiSchema fQi) fTableName) fColName
  where
    pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op
    sqlOperator o = HM.lookupDefault "=" o operators
-   notOp = if hasNot_ then "NOT" else ""
+   notOp = if hasNot then "NOT" else ""
    star c = if c == '*' then '%' else c
    unknownLiteral = (<> "::unknown ") . pgFmtLit
    whiteList :: Text -> SqlFragment
    whiteList v = fromMaybe
      (toS (pgFmtLit v) <> "::unknown ")
      (find ((==) . toLower $ v) ["null","true","false"])
-   pgFmtIn :: Operator -> [Text] -> SqlFragment
-   pgFmtIn op vals =
-    -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')"
-    let emptyValForIn o = (if "not" `isInfixOf` o then "NOT " else "") -- handle case of "notin" operator
-                          <> pgFmtField table fld <> " = any('{}') " in
-    case T.null <$> headMay vals of
-      Just isNull -> if isNull && length vals == 1
-                        then emptyValForIn op
-                        else pgFmtFieldOp op <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "
-      Nothing -> emptyValForIn op
 
 pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment
-pgFmtLogicTree qi (Expr hasNot_ op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
+pgFmtLogicTree qi (Expr hasNot op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
-  where notOp =  if hasNot_ then "NOT" else ""
+  where notOp =  if hasNot then "NOT" else ""
 pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt
 
 pgFmtJsonPath :: Maybe JsonPath -> SqlFragment

src/PostgREST/Types.hs

@@ -4,6 +4,7 @@ import           Protolude
 import qualified GHC.Show
 import           Data.Aeson
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.CaseInsensitive as CI
 import qualified Data.HashMap.Strict  as M
 import           Data.Tree
 import qualified Data.Vector          as V
@@ -30,6 +31,7 @@ data DbStructure = DbStructure {
 , dbRelations   :: [Relation]
 , dbPrimaryKeys :: [PrimaryKey]
 , dbProcs       :: M.HashMap Text ProcDescription
+, pgVersion     :: PgVersion
 } deriving (Show, Eq)
 
 data PgArg = PgArg {
@@ -148,7 +150,7 @@ data Proxy = Proxy {
 
 type Operator = Text
 operators :: M.HashMap Operator SqlFragment
-operators = M.fromList [
+operators = M.union (M.fromList [
   ("eq", "="),
   ("gte", ">="),
   ("gt", ">"),
@@ -158,10 +160,7 @@ operators = M.fromList [
   ("like", "LIKE"),
   ("ilike", "ILIKE"),
   ("in", "IN"),
-  ("notin", "NOT IN"),
-  ("isnot", "IS NOT"),
   ("is", "IS"),
-  ("fts", "@@"),
   ("cs", "@>"),
   ("cd", "<@"),
   ("ov", "&&"),
@@ -171,11 +170,28 @@ operators = M.fromList [
   ("nxl", "&>"),
   ("adj", "-|-"),
   -- TODO: these are deprecated and should be removed in v0.5.0.0
-  ("@@", "@@"),
   ("@>", "@>"),
-  ("<@", "<@")]
+  ("<@", "<@")]) ftsOperators
-data Operation = Operation{ hasNot::Bool, expr::(Operator, Operand) } deriving (Eq, Show)
+
-data Operand = VText Text | VTextL [Text] | VForeignKey QualifiedIdentifier ForeignKey deriving (Show, Eq)
+ftsOperators :: M.HashMap Operator SqlFragment
+ftsOperators = M.fromList [
+  ("@@", "@@ to_tsquery"), -- TODO: '@@' deprecated
+  ("fts", "@@ to_tsquery"),
+  ("plfts", "@@ plainto_tsquery"),
+  ("phfts", "@@ phraseto_tsquery")
+  ]
+
+data OpExpr = OpExpr Bool Operation deriving (Eq, Show)
+data Operation = Op Operator SingleVal |
+                 In ListVal |
+                 Fts Operator (Maybe Language) SingleVal |
+                 Join QualifiedIdentifier ForeignKey deriving (Eq, Show)
+type Language = Text
+
+-- | Represents a single value in a filter, e.g. id=eq.singleval
+type SingleVal = Text
+-- | Represents a list value in a filter, e.g. id=in.(val1,val2,val3)
+type ListVal = [Text]
 
 data LogicOperator = And | Or deriving Eq
 instance Show LogicOperator where
@@ -199,6 +215,25 @@ type Alias = Text
 type Cast = Text
 type NodeName = Text
 
+-- Rpc query param, only used for GET rpcs
+type RpcQParam = (Text, Text)
+
+{-|
+  Custom guc header, it's obtained by parsing the json in a:
+  `SET LOCAL "response.headers" = '[{"Set-Cookie": ".."}]'
+-}
+newtype GucHeader = GucHeader (Text, Text)
+
+instance FromJSON GucHeader where
+  parseJSON (Object o) = case headMay (M.toList o) of
+    Just (k, String s) | M.size o == 1 -> pure $ GucHeader (k, s)
+                       | otherwise     -> mzero
+    _ -> mzero
+  parseJSON _          = mzero
+
+toHeaders :: [GucHeader] -> [Header]
+toHeaders = map $ \(GucHeader (k, v)) -> (CI.mk $ toS k, toS v)
+
 {-|
   This type will hold information about which particular 'Relation' between two tables to choose when there are multiple ones.
   Specifically, it will contain the name of the foreign key or the join table in many to many relations.
@@ -207,7 +242,7 @@ type RelationDetail = Text
 type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe RelationDetail)
 -- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path ["clients", "projects"]
 type EmbedPath = [Text]
-data Filter = Filter { field::Field, operation::Operation } deriving (Show, Eq)
+data Filter = Filter { field::Field, opExpr::OpExpr } deriving (Show, Eq)
 
 data ReadQuery = Select { select::[SelectItem], from::[TableName], where_::[LogicTree], order::Maybe [OrderTerm], range_::NonnegRange } deriving (Show, Eq)
 data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON, returning::[FieldName] }
@@ -237,3 +272,11 @@ toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
 toMime CTOctetStream     = "application/octet-stream"
 toMime CTAny             = "*/*"
 toMime (CTOther ct)      = ct
+
+data PgVersion = PgVersion {
+  pgvNum  :: Int32
+, pgvName :: Text
+} deriving (Eq, Ord, Show)
+
+sourceCTEName :: SqlFragment
+sourceCTEName = "pg_source"

stack.yaml

@@ -1,11 +1,9 @@
-resolver: lts-9.0
+resolver: lts-9.6
 extra-deps:
   - configurator-ng-0.0.0.1
   - critbit-0.2.0.0
-  - hasql-pool-0.4.1
   - hjsonpointer-1.1.1
   - hjsonschema-1.5.0.1
-  - jose-0.5.0.3
   - Ranged-sets-0.3.0
   - protolude-0.2
 ghc-options:

test/Feature/AndOrParamsSpec.hs

@@ -73,6 +73,12 @@ spec =
         it "can handle fts" $ do
           get "/entities?or=(text_search_vector.fts.bar,text_search_vector.fts.baz)&select=id" `shouldRespondWith`
             [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }
+          get "/tsearch?or=(text_search_vector.plfts(german).Art%20Spass, text_search_vector.plfts(french).amusant%20impossible, text_search_vector.fts(english).impossible)" `shouldRespondWith`
+            [json|[
+              {"text_search_vector": "'fun':5 'imposs':9 'kind':3" },
+              {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" },
+              {"text_search_vector": "'art':4 'spass':5 'unmog':7"}
+            ]|] { matchHeaders = [matchContentTypeJson] }
           -- TODO: remove in 0.5.0 as deprecated
           get "/entities?or=(text_search_vector.@@.bar,text_search_vector.@@.baz)&select=id" `shouldRespondWith`
             [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }

test/Feature/AudienceJwtSecretSpec.hs

@@ -0,0 +1,47 @@
+module Feature.AudienceJwtSecretSpec where
+
+-- {{{ Imports
+import Test.Hspec
+import Test.Hspec.Wai
+import Network.HTTP.Types
+
+import SpecHelper
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+-- }}}
+
+spec :: SpecWith Application
+spec = describe "test handling of aud claims in JWT" $ do
+
+  -- this test will stop working 9999999999s after the UNIX EPOCH
+  it "succeeds with jwt token containing with an audience claim" $ do
+    {-  This is the decoded contents of authHeaderJWT
+
+        {
+          "exp": 9999999999,
+          "role": "postgrest_test_author",
+          "id": "jdoe",
+          "aud": "youraudience"
+        }
+
+    -}
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UiLCJhdWQiOiJ5b3VyYXVkaWVuY2UifQ.fJ4tLKSmolWGWehWN20qiU9dMO-WY0RI2VvacL7-ZGo"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  it "succeeds with jwt token that does not contain an audience claim" $ do
+    {- This is the decoded contents of authHeaderJWT
+
+        {
+          "exp": 9999999999,
+          "role": "postgrest_test_author",
+          "id": "jdoe"
+        }
+    -}
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA"
+    request methodGet "/authors_only" [auth] ""
+      `shouldRespondWith` 200
+
+  it "requests without JWT token should work" $
+    get "/has_count_column" `shouldRespondWith` 200 

test/Feature/AuthSpec.hs

@@ -1,6 +1,5 @@
 module Feature.AuthSpec where
 
--- {{{ Imports
 import Text.Heredoc
 import Test.Hspec
 import Test.Hspec.Wai
@@ -11,7 +10,6 @@ import SpecHelper
 import Network.Wai (Application)
 
 import Protolude hiding (get)
--- }}}
 
 spec :: SpecWith Application
 spec = describe "authorization" $ do
@@ -39,6 +37,17 @@ spec = describe "authorization" $ do
       , matchHeaders = []
       }
 
+  it "denies execution on functions that anonymous does not own" $
+    post "/rpc/privileged_hello" [json|{"name": "anonymous"}|] `shouldRespondWith` 401
+
+  it "allows execution on a function that postgrest_test_author owns" $
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA" in
+    request methodPost "/rpc/privileged_hello" [auth] [json|{"name": "jdoe"}|]
+      `shouldRespondWith` [json|"Privileged hello to jdoe"|]
+      { matchStatus = 200
+      , matchHeaders = [matchContentTypeJson]
+      }
+
   it "returns jwt functions as jwt tokens" $
     request methodPost "/rpc/login" [single]
       [json| { "id": "jdoe", "pass": "1234" } |]

test/Feature/InsertSpec.hs

@@ -423,9 +423,9 @@ spec = do
             matchStatus  = 204,
             matchHeaders = ["Content-Range" <:> "*/*"]
           }
-
+        get "/items" `shouldRespondWith`
-        g <- get "/items"
+          [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}]|]
-        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}] |]
+          { matchHeaders = [matchContentTypeJson] }
 
       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| {} |]
@@ -434,9 +434,9 @@ spec = do
             matchStatus  = 200,
             matchHeaders = ["Content-Range" <:> "*/*"]
           }
-
+        get "/items" `shouldRespondWith`
-        g <- get "/items"
+          [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}] |]
-        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}] |]
+          { matchHeaders = [matchContentTypeJson] }
   
     context "with unicode values" $
       it "succeeds and returns values intact" $ do

test/Feature/NonexistentSchemaSpec.hs

@@ -0,0 +1,15 @@
+module Feature.NonexistentSchemaSpec where
+
+import Network.Wai (Application)
+import Protolude hiding (get)
+import Test.Hspec
+import Test.Hspec.Wai
+
+spec :: SpecWith Application
+spec =
+  describe "Non existent api schema" $ do
+    it "succeeds when requesting root path" $
+      get "/" `shouldRespondWith` 200
+
+    it "gives 404 when requesting a nonexistent table in this nonexistent schema" $
+      get "/nonexistent_table" `shouldRespondWith` 404

test/Feature/PgVersion96Spec.hs

@@ -0,0 +1,81 @@
+module Feature.PgVersion96Spec where
+
+import Test.Hspec hiding (pendingWith)
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import SpecHelper
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
+  describe "features supported on PostgreSQL 9.6" $ do
+    context "GUC headers" $ do
+      it "succeeds setting the headers" $ do
+        get "/rpc/get_projects_and_guc_headers?id=eq.2&select=id"
+          `shouldRespondWith` [json|[{"id": 2}]|]
+          {matchHeaders = [
+              matchContentTypeJson,
+              "X-Test"   <:> "key1=val1; someValue; key2=val2",
+              "X-Test-2" <:> "key1=val1"]}
+        get "/rpc/get_int_and_guc_headers?num=1"
+          `shouldRespondWith` [json|1|]
+          {matchHeaders = [
+              matchContentTypeJson,
+              "X-Test"   <:> "key1=val1; someValue; key2=val2",
+              "X-Test-2" <:> "key1=val1"]}
+        post "/rpc/get_int_and_guc_headers" [json|{"num": 1}|]
+          `shouldRespondWith` [json|1|]
+          {matchHeaders = [
+              matchContentTypeJson,
+              "X-Test"   <:> "key1=val1; someValue; key2=val2",
+              "X-Test-2" <:> "key1=val1"]}
+
+      it "fails when setting headers with wrong json structure" $ do
+        get "/rpc/bad_guc_headers_1" `shouldRespondWith` 500
+        get "/rpc/bad_guc_headers_2" `shouldRespondWith` 500
+        get "/rpc/bad_guc_headers_3" `shouldRespondWith` 500
+        post "/rpc/bad_guc_headers_1" [json|{}|] `shouldRespondWith` 500
+
+      it "can set the same http header twice" $
+        get "/rpc/set_cookie_twice"
+          `shouldRespondWith` "null"
+          {matchHeaders = [
+              matchContentTypeJson,
+              "Set-Cookie" <:> "sessionid=38afes7a8; HttpOnly; Path=/",
+              "Set-Cookie" <:> "id=a3fWa; Expires=Wed, 21 Oct 2015 07:28:00 GMT; Secure; HttpOnly"]}
+
+    context "Use of the phraseto_tsquery function" $ do
+      it "finds matches" $
+        get "/tsearch?text_search_vector=phfts.The%20Fat%20Cats" `shouldRespondWith`
+          [json| [{"text_search_vector": "'ate':3 'cat':2 'fat':1 'rat':4" }] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "finds matches with different dictionaries" $
+        get "/tsearch?text_search_vector=phfts(german).Art%20Spass" `shouldRespondWith`
+          [json| [{"text_search_vector": "'art':4 'spass':5 'unmog':7" }] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can be negated with not operator" $
+        get "/tsearch?text_search_vector=not.phfts(english).The%20Fat%20Cats" `shouldRespondWith`
+          [json| [
+            {"text_search_vector": "'fun':5 'imposs':9 'kind':3"},
+            {"text_search_vector": "'also':2 'fun':3 'possibl':8"},
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can be used with or query param" $
+        get "/tsearch?or=(text_search_vector.phfts(german).Art%20Spass, text_search_vector.phfts(french).amusant, text_search_vector.fts(english).impossible)" `shouldRespondWith`
+          [json|[
+            {"text_search_vector": "'fun':5 'imposs':9 'kind':3" },
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" },
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}
+          ]|] { matchHeaders = [matchContentTypeJson] }
+
+      it "should work when used with GET RPC" $
+        get "/rpc/get_tsearch?text_search_vector=phfts(english).impossible" `shouldRespondWith`
+          [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]
+          { matchHeaders = [matchContentTypeJson] }

test/Feature/QueryLimitedSpec.hs

@@ -5,7 +5,6 @@ import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus))
-import Text.Heredoc
 import SpecHelper
 import Network.Wai (Application)
 
@@ -31,14 +30,14 @@ spec =
 
     it "limit works on all levels" $
       get "/users?select=id,tasks{id}&order=id.asc&tasks.order=id.asc"
-        `shouldRespondWith` [str|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]
+        `shouldRespondWith` [json|[{"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` [str|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
+        `shouldRespondWith` [json|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]
         { matchStatus  = 200
         , matchHeaders = ["Content-Range" <:> "0-1/*"]
         }

test/Feature/QuerySpec.hs

@@ -4,8 +4,7 @@ import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
-import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus,simpleBody))
+import Network.Wai.Test (SResponse(simpleHeaders))
-import qualified Data.ByteString.Lazy as BL (empty)
 
 import SpecHelper
 import Text.Heredoc
@@ -55,11 +54,6 @@ spec = do
         `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` [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` [json| [{"id":1},{"id":3},{"id":5}] |]
@@ -91,36 +85,81 @@ spec = do
 
     it "matches with ilike" $ do
       get "/simple_pk?k=ilike.xy*&order=extra.asc" `shouldRespondWith`
-        [str|[{"k":"xyyx","extra":"u"},{"k":"xYYx","extra":"v"}]|]
+        [json|[{"k":"xyyx","extra":"u"},{"k":"xYYx","extra":"v"}]|]
+        { matchHeaders = [matchContentTypeJson] }
       get "/simple_pk?k=ilike.*YY*&order=extra.asc" `shouldRespondWith`
-        [str|[{"k":"xyyx","extra":"u"},{"k":"xYYx","extra":"v"}]|]
+        [json|[{"k":"xyyx","extra":"u"},{"k":"xYYx","extra":"v"}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "matches with ilike using not operator" $
       get "/simple_pk?k=not.ilike.xy*&order=extra.asc" `shouldRespondWith` "[]"
 
-    it "matches with tsearch fts" $ do
+    describe "Full text search operator" $ do
-      get "/tsearch?text_search_vector=fts.impossible" `shouldRespondWith`
+      it "finds matches with to_tsquery" $
-        [json| [{"text_search_vector": "'fun':5 'imposs':9 'kind':3" }] |]
+        get "/tsearch?text_search_vector=fts.impossible" `shouldRespondWith`
-        { matchHeaders = [matchContentTypeJson] }
+          [json| [{"text_search_vector": "'fun':5 'imposs':9 'kind':3" }] |]
-      get "/tsearch?text_search_vector=fts.possible" `shouldRespondWith`
+          { matchHeaders = [matchContentTypeJson] }
-        [json| [{"text_search_vector": "'also':2 'fun':3 'possibl':8" }] |]
+
-        { matchHeaders = [matchContentTypeJson] }
+      it "can use lexeme boolean operators(&=%26, |=%7C, !) in to_tsquery" $ do
-      -- TODO: remove in 0.5.0 as deprecated
+        get "/tsearch?text_search_vector=fts.fun%26possible" `shouldRespondWith`
-      get "/tsearch?text_search_vector=@@.impossible" `shouldRespondWith`
+          [json| [ {"text_search_vector": "'also':2 'fun':3 'possibl':8"}] |]
-        [json| [{"text_search_vector": "'fun':5 'imposs':9 'kind':3" }] |]
+          { matchHeaders = [matchContentTypeJson] }
-        { matchHeaders = [matchContentTypeJson] }
+        get "/tsearch?text_search_vector=fts.impossible%7Cpossible" `shouldRespondWith`
-      get "/tsearch?text_search_vector=@@.possible" `shouldRespondWith`
+          [json| [
-        [json| [{"text_search_vector": "'also':2 'fun':3 'possibl':8" }] |]
+          {"text_search_vector": "'fun':5 'imposs':9 'kind':3"},
-        { matchHeaders = [matchContentTypeJson] }
+          {"text_search_vector": "'also':2 'fun':3 'possibl':8"}] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/tsearch?text_search_vector=fts.fun%26!possible" `shouldRespondWith`
+          [json| [ {"text_search_vector": "'fun':5 'imposs':9 'kind':3"}] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "finds matches with plainto_tsquery" $
+        get "/tsearch?text_search_vector=plfts.The%20Fat%20Rats" `shouldRespondWith`
+          [json| [ {"text_search_vector": "'ate':3 'cat':2 'fat':1 'rat':4" }] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "finds matches with different dictionaries" $ do
+        get "/tsearch?text_search_vector=fts(french).amusant" `shouldRespondWith`
+          [json| [{"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" }] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/tsearch?text_search_vector=plfts(french).amusant%20impossible" `shouldRespondWith`
+          [json| [{"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" }] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can be negated with not operator" $ do
+        get "/tsearch?text_search_vector=not.fts.impossible%7Cfat%7Cfun" `shouldRespondWith`
+          [json| [
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/tsearch?text_search_vector=not.fts(english).impossible%7Cfat%7Cfun" `shouldRespondWith`
+          [json| [
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/tsearch?text_search_vector=not.plfts.The%20Fat%20Rats" `shouldRespondWith`
+          [json| [
+            {"text_search_vector": "'fun':5 'imposs':9 'kind':3"},
+            {"text_search_vector": "'also':2 'fun':3 'possibl':8"},
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
 
-    it "matches with tsearch fts using not operator" $ do
-      get "/tsearch?text_search_vector=not.fts.impossible" `shouldRespondWith`
-        [json| [{"text_search_vector": "'also':2 'fun':3 'possibl':8" }] |]
-        { matchHeaders = [matchContentTypeJson] }
       -- TODO: remove in 0.5.0 as deprecated
-      get "/tsearch?text_search_vector=not.@@.impossible" `shouldRespondWith`
+      it "Deprecated @@ operator, pending to remove" $ do
-        [json| [{"text_search_vector": "'also':2 'fun':3 'possibl':8" }] |]
+        get "/tsearch?text_search_vector=@@.impossible" `shouldRespondWith`
-        { matchHeaders = [matchContentTypeJson] }
+          [json| [{"text_search_vector": "'fun':5 'imposs':9 'kind':3" }] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/tsearch?text_search_vector=not.@@.impossible%7Cfat%7Cfun" `shouldRespondWith`
+          [json| [
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/tsearch?text_search_vector=not.@@(english).impossible%7Cfat%7Cfun" `shouldRespondWith`
+          [json| [
+            {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"},
+            {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
 
     it "matches with computed column" $
       get "/items?always_true=eq.true&order=id.asc" `shouldRespondWith`
@@ -141,21 +180,26 @@ spec = do
 
     it "matches filtering nested items" $
       get "/clients?select=id,projects{id,tasks{id,name}}&projects.tasks.name=like.Design*" `shouldRespondWith`
-        [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1,"name":"Design w7"}]},{"id":2,"tasks":[{"id":3,"name":"Design w10"}]}]},{"id":2,"projects":[{"id":3,"tasks":[{"id":5,"name":"Design IOS"}]},{"id":4,"tasks":[{"id":7,"name":"Design OSX"}]}]}]|]
+        [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1,"name":"Design w7"}]},{"id":2,"tasks":[{"id":3,"name":"Design w10"}]}]},{"id":2,"projects":[{"id":3,"tasks":[{"id":5,"name":"Design IOS"}]},{"id":4,"tasks":[{"id":7,"name":"Design OSX"}]}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "matches with cs operator" $ do
       get "/complex_items?select=id&arr_data=cs.{2}" `shouldRespondWith`
-        [str|[{"id":2},{"id":3}]|]
+        [json|[{"id":2},{"id":3}]|]
+        { matchHeaders = [matchContentTypeJson] }
       -- TODO: remove in 0.5.0 as deprecated
       get "/complex_items?select=id&arr_data=@>.{2}" `shouldRespondWith`
-        [str|[{"id":2},{"id":3}]|]
+        [json|[{"id":2},{"id":3}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "matches with cd operator" $ do
       get "/complex_items?select=id&arr_data=cd.{1,2,4}" `shouldRespondWith`
-        [str|[{"id":1},{"id":2}]|]
+        [json|[{"id":1},{"id":2}]|]
+        { matchHeaders = [matchContentTypeJson] }
       -- TODO: remove in 0.5.0 as deprecated
       get "/complex_items?select=id&arr_data=<@.{1,2,4}" `shouldRespondWith`
-        [str|[{"id":1},{"id":2}]|]
+        [json|[{"id":1},{"id":2}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
 
   describe "Shaping response with select parameter" $ do
@@ -242,7 +286,41 @@ spec = do
 
     it "requesting parents and children" $
       get "/projects?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith`
-        [str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        [json|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "requesting parent without specifying primary key" $ do
+      get "/projects?select=name,client{name}" `shouldRespondWith`
+        [json|[
+          {"name":"Windows 7","client":{"name": "Microsoft"}},
+          {"name":"Windows 10","client":{"name": "Microsoft"}},
+          {"name":"IOS","client":{"name": "Apple"}},
+          {"name":"OSX","client":{"name": "Apple"}},
+          {"name":"Orphan","client":null}
+        ]|]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/articleStars?select=createdAt,article{owner},user{name}&limit=1" `shouldRespondWith`
+        [json|[{"createdAt":"2015-12-08T04:22:57.472738","article":{"owner": "postgrest_test_authenticator"},"user":{"name": "Angela Martin"}}]|]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "requesting parent and renaming primary key" $
+      get "/projects?select=name,client{clientId:id,name}" `shouldRespondWith`
+        [json|[
+          {"name":"Windows 7","client":{"name": "Microsoft", "clientId": 1}},
+          {"name":"Windows 10","client":{"name": "Microsoft", "clientId": 1}},
+          {"name":"IOS","client":{"name": "Apple", "clientId": 2}},
+          {"name":"OSX","client":{"name": "Apple", "clientId": 2}},
+          {"name":"Orphan","client":null}
+        ]|]
+        { matchHeaders = [matchContentTypeJson] }
+
+    it "requesting parent and specifying/renaming one key of the composite primary key" $ do
+      get "/comments?select=*,users_tasks{userId:user_id}" `shouldRespondWith`
+        [json|[{"id":1,"commenter_id":1,"user_id":2,"task_id":6,"content":"Needs to be delivered ASAP","users_tasks":{"userId": 2}}]|]
+        { matchHeaders = [matchContentTypeJson] }
+      get "/comments?select=*,users_tasks{taskId:task_id}" `shouldRespondWith`
+        [json|[{"id":1,"commenter_id":1,"user_id":2,"task_id":6,"content":"Needs to be delivered ASAP","users_tasks":{"taskId": 6}}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "embed data with two fk pointing to the same table" $
       get "/orders?id=eq.1&select=id, name, billing_address_id{id}, shipping_address_id{id}" `shouldRespondWith`
@@ -251,7 +329,8 @@ spec = do
 
     it "requesting parents and children while renaming them" $
       get "/projects?id=eq.1&select=myId:id, name, project_client:client_id{*}, project_tasks:tasks{id, name}" `shouldRespondWith`
-        [str|[{"myId":1,"name":"Windows 7","project_client":{"id":1,"name":"Microsoft"},"project_tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        [json|[{"myId":1,"name":"Windows 7","project_client":{"id":1,"name":"Microsoft"},"project_tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "requesting parents two levels up while using FK to specify the link" $
       get "/tasks?id=eq.1&select=id,name,project:project_id{id,name,client:client_id{id,name}}" `shouldRespondWith`
@@ -268,7 +347,8 @@ spec = do
 
     it "rows with missing parents are included" $
       get "/projects?id=in.1,5&select=id,clients{id}" `shouldRespondWith`
-        [str|[{"id":1,"clients":{"id":1}},{"id":5,"clients":null}]|]
+        [json|[{"id":1,"clients":{"id":1}},{"id":5,"clients":null}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "rows with no children return [] instead of null" $
       get "/projects?id=in.5&select=id,tasks{id}" `shouldRespondWith`
@@ -276,53 +356,70 @@ spec = do
 
     it "requesting children 2 levels" $
       get "/clients?id=eq.1&select=id,projects{id,tasks{id}}" `shouldRespondWith`
-        [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]
+        [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "requesting children 2 levels (with relation path fixed)" $
       get "/clients?id=eq.1&select=id,projects:projects.client_id{id,tasks{id}}" `shouldRespondWith`
-        [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]
+        [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "requesting many<->many relation" $
       get "/tasks?select=id,users{id}" `shouldRespondWith`
-        [str|[{"id":1,"users":[{"id":1},{"id":3}]},{"id":2,"users":[{"id":1}]},{"id":3,"users":[{"id":1}]},{"id":4,"users":[{"id":1}]},{"id":5,"users":[{"id":2},{"id":3}]},{"id":6,"users":[{"id":2}]},{"id":7,"users":[{"id":2}]},{"id":8,"users":[]}]|]
+        [json|[{"id":1,"users":[{"id":1},{"id":3}]},{"id":2,"users":[{"id":1}]},{"id":3,"users":[{"id":1}]},{"id":4,"users":[{"id":1}]},{"id":5,"users":[{"id":2},{"id":3}]},{"id":6,"users":[{"id":2}]},{"id":7,"users":[{"id":2}]},{"id":8,"users":[]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "requesting many<->many relation (with relation path fixed)" $
       get "/tasks?select=id,users:users.users_tasks{id}" `shouldRespondWith`
-        [str|[{"id":1,"users":[{"id":1},{"id":3}]},{"id":2,"users":[{"id":1}]},{"id":3,"users":[{"id":1}]},{"id":4,"users":[{"id":1}]},{"id":5,"users":[{"id":2},{"id":3}]},{"id":6,"users":[{"id":2}]},{"id":7,"users":[{"id":2}]},{"id":8,"users":[]}]|]
+        [json|[{"id":1,"users":[{"id":1},{"id":3}]},{"id":2,"users":[{"id":1}]},{"id":3,"users":[{"id":1}]},{"id":4,"users":[{"id":1}]},{"id":5,"users":[{"id":2},{"id":3}]},{"id":6,"users":[{"id":2}]},{"id":7,"users":[{"id":2}]},{"id":8,"users":[]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "requesting many<->many relation with rename" $
       get "/tasks?id=eq.1&select=id,theUsers:users{id}" `shouldRespondWith`
-        [str|[{"id":1,"theUsers":[{"id":1},{"id":3}]}]|]
+        [json|[{"id":1,"theUsers":[{"id":1},{"id":3}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
 
     it "requesting many<->many relation reverse" $
       get "/users?select=id,tasks{id}" `shouldRespondWith`
-        [str|[{"id":1,"tasks":[{"id":1},{"id":2},{"id":3},{"id":4}]},{"id":2,"tasks":[{"id":5},{"id":6},{"id":7}]},{"id":3,"tasks":[{"id":1},{"id":5}]}]|]
+        [json|[{"id":1,"tasks":[{"id":1},{"id":2},{"id":3},{"id":4}]},{"id":2,"tasks":[{"id":5},{"id":6},{"id":7}]},{"id":3,"tasks":[{"id":1},{"id":5}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "requesting parents and children on views" $
       get "/projects_view?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith`
-        [str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        [json|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "requesting parents and children on views with renamed keys" $
       get "/projects_view_alt?t_id=eq.1&select=t_id, name, clients{*}, tasks{id, name}" `shouldRespondWith`
-        [str|[{"t_id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        [json|[{"t_id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
 
     it "requesting children with composite key" $
       get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments{content}" `shouldRespondWith`
-        [str|[{"user_id":2,"task_id":6,"comments":[{"content":"Needs to be delivered ASAP"}]}]|]
+        [json|[{"user_id":2,"task_id":6,"comments":[{"content":"Needs to be delivered ASAP"}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "detect relations in views from exposed schema that are based on tables in private schema and have columns renames" $
       get "/articles?id=eq.1&select=id,articleStars{users{*}}" `shouldRespondWith`
-        [str|[{"id":1,"articleStars":[{"users":{"id":1,"name":"Angela Martin"}},{"users":{"id":2,"name":"Michael Scott"}},{"users":{"id":3,"name":"Dwight Schrute"}}]}]|]
+        [json|[{"id":1,"articleStars":[{"users":{"id":1,"name":"Angela Martin"}},{"users":{"id":2,"name":"Michael Scott"}},{"users":{"id":3,"name":"Dwight Schrute"}}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
-    it "can select by column name" $
+    it "can embed by FK column name" $
-      get "/projects?id=in.1,3&select=id,name,client_id,client_id{id,name}" `shouldRespondWith`
+      get "/projects?id=in.1,3&select=id,name,client_id{id,name}" `shouldRespondWith`
-        [str|[{"id":1,"name":"Windows 7","client_id":1,"client_id":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client_id":{"id":2,"name":"Apple"}}]|]
+        [json|[{"id":1,"name":"Windows 7","client_id":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":{"id":2,"name":"Apple"}}]|]
+        { matchHeaders = [matchContentTypeJson] }
+    
+    it "can embed by FK column name and select the FK value at the same time, if aliased" $
+      get "/projects?id=in.1,3&select=id,name,client_id,client:client_id{id,name}" `shouldRespondWith`
+        [json|[{"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"}}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "can select by column name sans id" $
       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"}}]|]
+        [json|[{"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"}}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "can detect fk relations through views to tables in the public schema" $
       get "/consumers_view?select=*,orders_view{*}" `shouldRespondWith` 200
@@ -394,15 +491,18 @@ spec = do
 
     it "ordering embeded entities" $
       get "/projects?id=eq.1&select=id, name, tasks{id, name}&tasks.order=name.asc" `shouldRespondWith`
-        [str|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
+        [json|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "ordering embeded entities with alias" $
       get "/projects?id=eq.1&select=id, name, the_tasks:tasks{id, name}&tasks.order=name.asc" `shouldRespondWith`
-        [str|[{"id":1,"name":"Windows 7","the_tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
+        [json|[{"id":1,"name":"Windows 7","the_tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "ordering embeded entities, two levels" $
       get "/projects?id=eq.1&select=id, name, tasks{id, name, users{id, name}}&tasks.order=name.asc&tasks.users.order=name.desc" `shouldRespondWith`
-        [str|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7","users":[{"id":1,"name":"Angela Martin"}]},{"id":1,"name":"Design w7","users":[{"id":3,"name":"Dwight Schrute"},{"id":1,"name":"Angela Martin"}]}]}]|]
+        [json|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7","users":[{"id":1,"name":"Angela Martin"}]},{"id":1,"name":"Design w7","users":[{"id":3,"name":"Dwight Schrute"},{"id":1,"name":"Angela Martin"}]}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
 
     it "ordering embeded parents does not break things" $
       get "/projects?id=eq.1&select=id, name, clients{id, name}&clients.order=name.asc" `shouldRespondWith`
@@ -491,214 +591,6 @@ spec = do
         [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` [json| [{"id":3}] |]
-            { matchStatus = 200
-            , matchHeaders = ["Content-Range" <:> "0-0/*"]
-            }
-
-      it "includes total count if requested" $
-        request methodPost "/rpc/getitemrange"
-                (rangeHdrsWithCount (ByteRangeFromTo 0 0))
-                [json| { "min": 2, "max": 4 } |]
-           `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] }
-
-      it "returns CSV" $
-        request methodPost "/rpc/getitemrange"
-                (acceptHdrs "text/csv")
-                [json| { "min": 2, "max": 4 } |]
-           `shouldRespondWith` "id\n3\n4"
-            { matchStatus = 200
-            , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
-            }
-
-    context "unknown function" $
-      it "returns 404" $
-        post "/rpc/fakefunc" [json| {} |] `shouldRespondWith` 404
-
-    context "shaping the response returned by a proc" $ do
-      it "returns a project" $
-        post "/rpc/getproject" [json| { "id": 1} |] `shouldRespondWith`
-          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
-
-      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` [json|[{"id":3},{"id":4}]|]
-             { matchStatus = 200
-             , matchHeaders = ["Content-Range" <:> "1-2/*"]
-             }
-
-      it "select works on the first level" $
-        post "/rpc/getproject?select=id,name" [json| { "id": 1} |] `shouldRespondWith`
-          [str|[{"id":1,"name":"Windows 7"}]|]
-
-    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 "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, ￥"|]
-            { matchHeaders = [matchContentTypeJson] }
-
-      it "returns array" $
-        post "/rpc/ret_array" [json|{}|] `shouldRespondWith`
-          [json|[1, 2, 3]|]
-          { matchHeaders = [matchContentTypeJson] }
-
-      it "returns setof integers" $
-        post "/rpc/ret_setof_integers" [json|{}|] `shouldRespondWith`
-          [json|[{ "ret_setof_integers": 1 },
-                 { "ret_setof_integers": 2 },
-                 { "ret_setof_integers": 3 }]|]
-          { 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" $
-        request methodPost "/rpc/sayhello"
-          (acceptHdrs "audio/mpeg3") [json| { "name": "world" } |]
-            `shouldRespondWith` 415
-      it "rejects malformed json payload" $ do
-        p <- request methodPost "/rpc/sayhello"
-          (acceptHdrs "application/json") "sdfsdf"
-        liftIO $ do
-          simpleStatus p `shouldBe` badRequest400
-          isErrorFormat (simpleBody p) `shouldBe` True
-      it "treats simple plpgsql raise as invalid input" $ do
-        p <- post "/rpc/problem" "{}"
-        liftIO $ do
-          simpleStatus p `shouldBe` badRequest400
-          isErrorFormat (simpleBody p) `shouldBe` True
-
-    context "unsupported verbs" $ do
-      it "DELETE fails" $
-        request methodDelete "/rpc/sayhello" [] ""
-          `shouldRespondWith` 405
-      it "PATCH fails" $
-        request methodPatch "/rpc/sayhello" [] ""
-          `shouldRespondWith` 405
-      it "OPTIONS fails" $
-        -- TODO: should return info about the function
-        request methodOptions "/rpc/sayhello" [] ""
-          `shouldRespondWith` 405
-      it "GET fails with 405 on unknown procs" $
-        -- TODO: should this be 404?
-        get "/rpc/fake" `shouldRespondWith` 405
-      it "GET with 405 on known procs" $
-        get "/rpc/sayhello" `shouldRespondWith` 405
-
-    it "executes the proc exactly once per request" $ do
-      post "/rpc/callcounter" [json| {} |] `shouldRespondWith`
-        [json|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"
-          [("Prefer","params=single-object"),("Content-Type", "application/x-www-form-urlencoded")]
-          ("integer=7&double=2.71828&varchar=forms+are+fun&" <>
-           "boolean=false&date=1900-01-01&money=$3.99&enum=foo") `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] }
-
-    it "returns proper output when having the same return col name as the proc name" $
-      post "/rpc/test" [json|{}|] `shouldRespondWith`
-        [json|[{"test":"hello","value":1}]|] { matchHeaders = [matchContentTypeJson] }
-
   describe "weird requests" $ do
     it "can query as normal" $ do
       get "/Escap3e;" `shouldRespondWith`
@@ -814,7 +706,7 @@ spec = do
           , matchHeaders = []
           }
 
-  describe "values with quotes in IN and NOTIN operators" $ do
+  describe "values with quotes in IN and NOT IN" $ 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"}] |]
@@ -822,9 +714,6 @@ spec = do
       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] }
@@ -836,9 +725,6 @@ spec = do
       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`
@@ -875,10 +761,6 @@ spec = do
         get "/items_with_different_col_types?time_data=in." `shouldRespondWith`
           [json| [] |] { matchHeaders = [matchContentTypeJson] }
 
-    it "returns all results for notin when no value is present" $
-      get "/items_with_different_col_types?int_data=notin.&select=int_data" `shouldRespondWith`
-        [json| [{int_data: 1}] |] { matchHeaders = [matchContentTypeJson] }
-
     it "returns all results for not.in when no value is present" $
       get "/items_with_different_col_types?int_data=not.in.&select=int_data" `shouldRespondWith`
         [json| [{int_data: 1}] |] { matchHeaders = [matchContentTypeJson] }
@@ -894,9 +776,7 @@ spec = do
       get "/items_with_different_col_types?int_data=in.()" `shouldRespondWith`
         [json| [] |] { matchHeaders = [matchContentTypeJson] }
 
-    it "returns all results when the notin value is empty between parentheses" $ do
+    it "returns all results when the not.in value is empty between parentheses" $
-      get "/items_with_different_col_types?int_data=notin.()&select=int_data" `shouldRespondWith`
-        [json| [{int_data: 1}] |] { matchHeaders = [matchContentTypeJson] }
       get "/items_with_different_col_types?int_data=not.in.()&select=int_data" `shouldRespondWith`
         [json| [{int_data: 1}] |] { matchHeaders = [matchContentTypeJson] }
 
@@ -916,3 +796,13 @@ spec = do
       it "works with brackets" $
         get "/entities?id=eq.2&select=id,child_entities{id}" `shouldRespondWith`
           [json| [{"id": 2, "child_entities": [{"id": 3}]}] |] { matchHeaders = [matchContentTypeJson] }
+
+  context "Embedding when column name = table name" $ do
+    it "works with child embeds" $
+      get "/being?select=*,descendant(*)&limit=1" `shouldRespondWith`
+        [json|[{"being":1,"descendant":[{"descendant":1,"being":1},{"descendant":2,"being":1},{"descendant":3,"being":1}]}]|]
+        { matchHeaders = [matchContentTypeJson] }
+    it "works with many to many embeds" $
+      get "/being?select=*,part(*)&limit=1" `shouldRespondWith`
+        [json|[{"being":1,"part":[{"part":1}]}]|]
+        { matchHeaders = [matchContentTypeJson] }

test/Feature/RangeSpec.hs

@@ -9,7 +9,6 @@ import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
 import qualified Data.ByteString.Lazy         as BL
 
 import SpecHelper
-import Text.Heredoc
 import Network.Wai (Application)
 
 import Protolude hiding (get)
@@ -131,20 +130,20 @@ spec = do
       it "no parameters return everything" $
         get "/items?select=id&order=id.asc"
           `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}]|]
+          [json|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-14/*"]
           }
       it "top level limit with parameter" $
         get "/items?select=id&order=id.asc&limit=3"
-          `shouldRespondWith` [str|[{"id":1},{"id":2},{"id":3}]|]
+          `shouldRespondWith` [json|[{"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` [str|[{"id":1},{"id":2}]|]
+          `shouldRespondWith` [json|[{"id":1},{"id":2}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-1/*"]
           }
@@ -152,7 +151,7 @@ spec = do
       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`
-          [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]
+          [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "0-0/*"]
           }
@@ -160,7 +159,7 @@ spec = do
 
       it "limit and offset works on first level" $
         get "/items?select=id&order=id.asc&limit=3&offset=2"
-          `shouldRespondWith` [str|[{"id":3},{"id":4},{"id":5}]|]
+          `shouldRespondWith` [json|[{"id":3},{"id":4},{"id":5}]|]
           { matchStatus  = 200
           , matchHeaders = ["Content-Range" <:> "2-4/*"]
           }

test/Feature/RpcSpec.hs

@@ -0,0 +1,345 @@
+module Feature.RpcSpec where
+
+import Test.Hspec hiding (pendingWith)
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+import Network.HTTP.Types
+import Network.Wai.Test (SResponse(simpleStatus, simpleBody))
+import qualified Data.ByteString.Lazy as BL (empty)
+
+import SpecHelper
+import Text.Heredoc
+import Network.Wai (Application)
+
+import Protolude hiding (get)
+
+spec :: SpecWith Application
+spec =
+  describe "remote procedure call" $ do
+    context "a proc that returns a set" $ do
+      it "returns paginated results" $ do
+        request methodPost "/rpc/getitemrange"
+                (rangeHdrs (ByteRangeFromTo 0 0))  [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 200
+            , matchHeaders = ["Content-Range" <:> "0-0/*"]
+            }
+        request methodGet "/rpc/getitemrange?min=2&max=4"
+                (rangeHdrs (ByteRangeFromTo 0 0)) ""
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 200
+            , matchHeaders = ["Content-Range" <:> "0-0/*"]
+            }
+
+      it "includes total count if requested" $ do
+        request methodPost "/rpc/getitemrange"
+                (rangeHdrsWithCount (ByteRangeFromTo 0 0))
+                [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 206 -- it now knows the response is partial
+            , matchHeaders = ["Content-Range" <:> "0-0/2"]
+            }
+        request methodGet "/rpc/getitemrange?min=2&max=4"
+                (rangeHdrsWithCount (ByteRangeFromTo 0 0)) ""
+           `shouldRespondWith` [json| [{"id":3}] |]
+            { matchStatus = 206
+            , matchHeaders = ["Content-Range" <:> "0-0/2"]
+            }
+
+      it "returns proper json" $ do
+        post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
+          [json| [ {"id": 3}, {"id":4} ] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/getitemrange?min=2&max=4" `shouldRespondWith`
+          [json| [ {"id": 3}, {"id":4} ] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns CSV" $ do
+        request methodPost "/rpc/getitemrange"
+                (acceptHdrs "text/csv")
+                [json| { "min": 2, "max": 4 } |]
+           `shouldRespondWith` "id\n3\n4"
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+            }
+        request methodGet "/rpc/getitemrange?min=2&max=4"
+                (acceptHdrs "text/csv") ""
+           `shouldRespondWith` "id\n3\n4"
+            { matchStatus = 200
+            , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
+            }
+
+    context "unknown function" $ do
+      it "returns 404" $
+        post "/rpc/fakefunc" [json| {} |] `shouldRespondWith` 404
+      it "should fail with 404 on unknown proc name" $
+        get "/rpc/fake" `shouldRespondWith` 404
+      it "should fail with 404 on unknown proc args" $ do
+        get "/rpc/sayhello" `shouldRespondWith` 404
+        get "/rpc/sayhello?any_arg=value" `shouldRespondWith` 404
+
+    context "shaping the response returned by a proc" $ do
+      it "returns a project" $ do
+        post "/rpc/getproject" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
+        get "/rpc/getproject?id=1" `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7","client_id":1}]|]
+
+      it "can filter proc results" $ do
+        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" [json| {} |] `shouldRespondWith`
+          [json|[{"id":2},{"id":3},{"id":4}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" `shouldRespondWith`
+          [json|[{"id":2},{"id":3},{"id":4}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "can limit proc results" $ do
+        post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1" [json| {} |]
+          `shouldRespondWith` [json|[{"id":3},{"id":4}]|]
+             { matchStatus = 200
+             , matchHeaders = ["Content-Range" <:> "1-2/*"] }
+        get "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1"
+          `shouldRespondWith` [json|[{"id":3},{"id":4}]|]
+             { matchStatus = 200
+             , matchHeaders = ["Content-Range" <:> "1-2/*"] }
+
+      it "select works on the first level" $ do
+        post "/rpc/getproject?select=id,name" [json| { "id": 1} |] `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7"}]|]
+        get "/rpc/getproject?id=1&select=id,name" `shouldRespondWith`
+          [str|[{"id":1,"name":"Windows 7"}]|]
+
+    context "foreign entities embedding" $ do
+      it "can embed if related tables are in the exposed schema" $ do
+        post "/rpc/getproject?select=id,name,client{id},tasks{id}" [json| { "id": 1} |] `shouldRespondWith`
+          [json|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/getproject?id=1&select=id,name,client{id},tasks{id}" `shouldRespondWith`
+          [json|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "cannot embed if the related table is not in the exposed schema" $ do
+        post "/rpc/single_article?select=*,article_stars{*}" [json|{ "id": 1}|]
+          `shouldRespondWith` 400
+        get "/rpc/single_article?id=1&select=*,article_stars{*}"
+          `shouldRespondWith` 400
+
+      it "can embed if the related tables are in a hidden schema but exposed as views" $ do
+        post "/rpc/single_article?select=id,articleStars{userId}" [json|{ "id": 2}|]
+          `shouldRespondWith` [json|[{"id": 2, "articleStars": [{"userId": 3}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/single_article?id=2&select=id,articleStars{userId}"
+          `shouldRespondWith` [json|[{"id": 2, "articleStars": [{"userId": 3}]}]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+    context "a proc that returns an empty rowset" $
+      it "returns empty json array" $ do
+        post "/rpc/test_empty_rowset" [json| {} |] `shouldRespondWith`
+          [json| [] |]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/test_empty_rowset" `shouldRespondWith`
+          [json| [] |]
+          { matchHeaders = [matchContentTypeJson] }
+
+    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, ￥"|]
+            { matchHeaders = [matchContentTypeJson] }
+
+      it "returns array" $
+        post "/rpc/ret_array" [json|{}|] `shouldRespondWith`
+          [json|[1, 2, 3]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "returns setof integers" $
+        post "/rpc/ret_setof_integers" [json|{}|] `shouldRespondWith`
+          [json|[{ "ret_setof_integers": 1 },
+                 { "ret_setof_integers": 2 },
+                 { "ret_setof_integers": 3 }]|]
+          { 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" $ do
+        request methodPost "/rpc/sayhello"
+          (acceptHdrs "audio/mpeg3") [json| { "name": "world" } |]
+            `shouldRespondWith` 415
+        request methodGet "/rpc/sayhello?name=world"
+          (acceptHdrs "audio/mpeg3") ""
+            `shouldRespondWith` 415
+      it "rejects malformed json payload" $ do
+        p <- request methodPost "/rpc/sayhello"
+          (acceptHdrs "application/json") "sdfsdf"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
+      it "treats simple plpgsql raise as invalid input" $ do
+        p <- post "/rpc/problem" "{}"
+        liftIO $ do
+          simpleStatus p `shouldBe` badRequest400
+          isErrorFormat (simpleBody p) `shouldBe` True
+
+    context "unsupported verbs" $ do
+      it "DELETE fails" $
+        request methodDelete "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "PATCH fails" $
+        request methodPatch "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+      it "OPTIONS fails" $
+        -- TODO: should return info about the function
+        request methodOptions "/rpc/sayhello" [] ""
+          `shouldRespondWith` 405
+
+    it "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 "a proc that receives no parameters" $ do
+      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] }
+      it "interprets empty string as a function with no args on a get request" $
+        get "/rpc/noparamsproc" `shouldRespondWith`
+          [json| "Return value of no parameters procedure." |]
+          { matchHeaders = [matchContentTypeJson] }
+
+    it "returns proper output when having the same return col name as the proc name" $ do
+      post "/rpc/test" [json|{}|] `shouldRespondWith`
+        [json|[{"test":"hello","value":1}]|] { matchHeaders = [matchContentTypeJson] }
+      get "/rpc/test" `shouldRespondWith`
+        [json|[{"test":"hello","value":1}]|] { matchHeaders = [matchContentTypeJson] }
+
+    context "procs with OUT/INOUT params" $ do
+      it "returns a scalar result when there is a single OUT param" $ do
+        get "/rpc/single_out_param?num=5" `shouldRespondWith`
+          [json|6|] { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/single_json_out_param?a=1&b=two" `shouldRespondWith`
+          [json|{"a": 1, "b": "two"}|] { matchHeaders = [matchContentTypeJson] }
+
+      it "returns a scalar result when there is a single INOUT param" $
+        get "/rpc/single_inout_param?num=2" `shouldRespondWith`
+          [json|3|] { matchHeaders = [matchContentTypeJson] }
+
+      it "returns a row result when there are many OUT params" $
+        get "/rpc/many_out_params" `shouldRespondWith`
+          [json|[{"my_json":{"a": 1, "b": "two"},"num":3,"str":"four"}]|] { matchHeaders = [matchContentTypeJson] }
+
+      it "returns a row result when there are many INOUT params" $
+        get "/rpc/many_inout_params?num=1&str=two" `shouldRespondWith`
+          [json| [{"num":1,"str":"two","b":true}]|] { matchHeaders = [matchContentTypeJson] }
+
+    it "can map a RAISE error code and message to a http status" $
+      get "/rpc/raise_pt402"
+        `shouldRespondWith` [json|{ "hint": "Upgrade your plan", "details": "Quota exceeded" }|]
+        { matchStatus  = 402
+        , matchHeaders = [matchContentTypeJson]
+        }
+
+    it "defaults to status 500 if RAISE code is PT not followed by a number" $
+      get "/rpc/raise_bad_pt" `shouldRespondWith` 500
+
+    context "only for POST rpc" $ do
+      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"
+            [("Prefer","params=single-object"),("Content-Type", "application/x-www-form-urlencoded")]
+            ("integer=7&double=2.71828&varchar=forms+are+fun&" <>
+             "boolean=false&date=1900-01-01&money=$3.99&enum=foo") `shouldRespondWith`
+            [json| { "integer": "7", "double": "2.71828", "varchar" : "forms are fun"
+                   , "boolean":"false", "date":"1900-01-01", "money":"$3.99", "enum":"foo" } |]
+                   { matchHeaders = [matchContentTypeJson] }
+
+      it "gives a parse filter error if GET style proc args are specified" $
+        post "/rpc/sayhello?name=John" [json|{}|] `shouldRespondWith` 400
+
+    context "only for GET rpc" $ do
+      it "should fail on mutating procs" $ do
+        get "/rpc/callcounter" `shouldRespondWith` 500
+        get "/rpc/setprojects?id_l=1&id_h=5&name=FreeBSD" `shouldRespondWith` 500
+
+      it "should filter a proc that has arg name = filter name" $
+        get "/rpc/get_projects_below?id=5&id=gt.2&select=id" `shouldRespondWith`
+          [json|[{ "id": 3 }, { "id": 4 }]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "should work with filters that have the not operator" $ do
+        get "/rpc/get_projects_below?id=5&id=not.gt.2&select=id" `shouldRespondWith`
+          [json|[{ "id": 1 }, { "id": 2 }]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/get_projects_below?id=5&id=not.in.(1,3)&select=id" `shouldRespondWith`
+          [json|[{ "id": 2 }, { "id": 4 }]|]
+          { matchHeaders = [matchContentTypeJson] }
+
+      it "should work with filters that use the plain with language fts operator" $ do
+        get "/rpc/get_tsearch?text_search_vector=fts(english).impossible" `shouldRespondWith`
+          [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/get_tsearch?text_search_vector=plfts.impossible" `shouldRespondWith`
+          [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/get_tsearch?text_search_vector=not.fts(english).fun%7Crat" `shouldRespondWith`
+          [json|[{"text_search_vector":"'amus':5 'fair':7 'impossibl':9 'peu':4"},{"text_search_vector":"'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        -- TODO: '@@' deprecated
+        get "/rpc/get_tsearch?text_search_vector=@@(english).impossible" `shouldRespondWith`
+          [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]
+          { matchHeaders = [matchContentTypeJson] }
+        get "/rpc/get_tsearch?text_search_vector=not.@@(english).fun%7Crat" `shouldRespondWith`
+          [json|[{"text_search_vector":"'amus':5 'fair':7 'impossibl':9 'peu':4"},{"text_search_vector":"'art':4 'spass':5 'unmog':7"}]|]
+          { matchHeaders = [matchContentTypeJson] }

test/Feature/SingularSpec.hs

@@ -39,7 +39,8 @@ spec =
       it "can shape plurality singular object routes" $
         request methodGet "/projects_view?id=eq.1&select=id,name,clients{*},tasks{id,name}" [singular] ""
           `shouldRespondWith`
-            [str|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|]
+            [json|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|]
+            { matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"] }
 
     context "when updating rows" $ do
 

test/Feature/StructureSpec.hs

@@ -4,7 +4,9 @@ import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Network.HTTP.Types
 
+import PostgREST.Config (docsVersion)
 import Control.Lens ((^?))
+import Data.Aeson.Types (Value (..))
 import Data.Aeson.Lens
 import Data.Aeson.QQ
 
@@ -27,7 +29,14 @@ spec = do
               (acceptHdrs "application/openapi+json") ""
         `shouldRespondWith` 415
 
-    describe "table" $
+    it "includes postgrest.com current version api docs" $ do
+      r <- simpleBody <$> get "/"
+
+      let docsUrl = r ^? key "externalDocs" . key "url"
+
+      liftIO $ docsUrl `shouldBe` Just (String ("https://postgrest.com/en/" <> docsVersion <> "/api.html"))
+
+    describe "table" $ do
 
       it "includes paths to tables" $ do
         r <- simpleBody <$> get "/"
@@ -76,7 +85,7 @@ spec = do
 
           deleteResponse `shouldBe` Just "No Content"
 
-    it "includes definitions to tables" $ do
+      it "includes definitions to tables" $ do
         r <- simpleBody <$> get "/"
 
         let def = r ^? key "definitions" . key "child_entities"
@@ -108,7 +117,21 @@ spec = do
               }
             |]
 
-    describe "RPC" $
+      it "doesn't include privileged table for anonymous" $ do
+        r <- simpleBody <$> get "/"
+        let tablePath = r ^? key "paths" . key "/authors_only"
+
+        liftIO $ tablePath `shouldBe` Nothing
+
+      it "includes table if user has permission" $ do
+        let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"
+        r <- simpleBody <$> request methodGet "/" [auth] ""
+        let tableTag = r ^? key "paths" . key "/authors_only"
+                      . key "post"  . key "tags"
+                      . nth 0
+        liftIO $ tableTag `shouldBe` Just [aesonQQ|"authors_only"|]
+
+    describe "RPC" $ do
 
       it "includes body schema for arguments" $ do
         r <- simpleBody <$> get "/"
@@ -162,6 +185,37 @@ spec = do
               }
             |]
 
+      it "doesn't include privileged function for anonymous" $ do
+        r <- simpleBody <$> get "/"
+        let funcPath = r ^? key "paths" . key "/rpc/privileged_hello"
+
+        liftIO $ funcPath `shouldBe` Nothing
+
+      it "includes function if user has permission" $ do
+        let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"
+        r <- simpleBody <$> request methodGet "/" [auth] ""
+        let funcTag = r ^? key "paths" . key "/rpc/privileged_hello"
+                      . key "post"  . key "tags"
+                      . nth 0
+
+        liftIO $ funcTag `shouldBe` Just [aesonQQ|"(rpc) privileged_hello"|]
+
+      it "doesn't include OUT params of function as required parameters" $ do
+        r <- simpleBody <$> get "/"
+        let params = r ^? key "paths" . key "/rpc/many_out_params"
+                        . key "post" . key "parameters" .  nth 0
+                        . key "schema". key "required"
+
+        liftIO $ params `shouldBe` Nothing
+
+      it "includes INOUT params(with no DEFAULT) of function as required parameters" $ do
+        r <- simpleBody <$> get "/"
+        let params = r ^? key "paths" . key "/rpc/many_inout_params"
+                        . key "post" . key "parameters" .  nth 0
+                        . key "schema". key "required"
+
+        liftIO $ params `shouldBe` Just [aesonQQ|["num", "str"]|]
+
   describe "Allow header" $ do
 
     it "includes read/write verbs for writeable table" $ do

test/Main.hs

@@ -5,14 +5,17 @@ import SpecHelper
 
 import qualified Hasql.Pool as P
 
-import PostgREST.DbStructure (getDbStructure)
 import PostgREST.App (postgrest)
+import PostgREST.Config (pgVersion96)
+import PostgREST.DbStructure (getDbStructure, getPgVersion)
+import PostgREST.Types (DbStructure(..))
 import Data.Function (id)
 import Data.IORef
 
 import qualified Feature.AuthSpec
 import qualified Feature.AsymmetricJwtSpec
 import qualified Feature.BinaryJwtSecretSpec
+import qualified Feature.AudienceJwtSecretSpec
 import qualified Feature.ConcurrentSpec
 import qualified Feature.CorsSpec
 import qualified Feature.DeleteSpec
@@ -26,6 +29,9 @@ import qualified Feature.SingularSpec
 import qualified Feature.UnicodeSpec
 import qualified Feature.ProxySpec
 import qualified Feature.AndOrParamsSpec
+import qualified Feature.RpcSpec
+import qualified Feature.NonexistentSchemaSpec
+import qualified Feature.PgVersion96Spec
 
 import Protolude
 
@@ -36,17 +42,42 @@ main = do
 
   pool <- P.acquire (3, 10, toS testDbConn)
 
-  result <- P.use pool $ getDbStructure "test"
+  result <- P.use pool $ getDbStructure "test" =<< getPgVersion
-  refDbStructure <- newIORef $ Just $ either (panic.show) id result
+
-  let withApp      = return $ postgrest (testCfg testDbConn)          refDbStructure pool $ pure ()
+  dbStructure <- pure $ either (panic.show) id result
-      ltdApp       = return $ postgrest (testLtdRowsCfg testDbConn)   refDbStructure pool $ pure ()
+
-      unicodeApp   = return $ postgrest (testUnicodeCfg testDbConn)   refDbStructure pool $ pure ()
+  refDbStructure <- newIORef $ Just dbStructure
-      proxyApp     = return $ postgrest (testProxyCfg testDbConn)     refDbStructure pool $ pure ()
+
-      noJwtApp     = return $ postgrest (testCfgNoJWT testDbConn)     refDbStructure pool $ pure ()
+  let withApp              = return $ postgrest (testCfg testDbConn)            refDbStructure pool $ pure ()
-      binaryJwtApp = return $ postgrest (testCfgBinaryJWT testDbConn) refDbStructure pool $ pure ()
+      ltdApp               = return $ postgrest (testLtdRowsCfg testDbConn)     refDbStructure pool $ pure ()
-      asymJwkApp   = return $ postgrest (testCfgAsymJWK testDbConn)   refDbStructure pool $ pure ()
+      unicodeApp           = return $ postgrest (testUnicodeCfg testDbConn)     refDbStructure pool $ pure ()
+      proxyApp             = return $ postgrest (testProxyCfg testDbConn)       refDbStructure pool $ pure ()
+      noJwtApp             = return $ postgrest (testCfgNoJWT testDbConn)       refDbStructure pool $ pure ()
+      binaryJwtApp         = return $ postgrest (testCfgBinaryJWT testDbConn)   refDbStructure pool $ pure ()
+      audJwtApp            = return $ postgrest (testCfgAudienceJWT testDbConn) refDbStructure pool $ pure ()
+      asymJwkApp           = return $ postgrest (testCfgAsymJWK testDbConn)     refDbStructure pool $ pure ()
+      nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn)   refDbStructure pool $ pure ()
 
   let reset = resetDb testDbConn
+      actualPgVersion = pgVersion dbStructure
+      pg96spec | actualPgVersion >= pgVersion96 = [("Feature.PgVersion96Spec"  , Feature.PgVersion96Spec.spec)]
+               | otherwise = []
+
+      specs = uncurry describe <$> [
+          ("Feature.AuthSpec"               , Feature.AuthSpec.spec)
+        , ("Feature.ConcurrentSpec"         , Feature.ConcurrentSpec.spec)
+        , ("Feature.CorsSpec"               , Feature.CorsSpec.spec)
+        , ("Feature.DeleteSpec"             , Feature.DeleteSpec.spec)
+        , ("Feature.InsertSpec"             , Feature.InsertSpec.spec)
+        , ("Feature.QuerySpec"              , Feature.QuerySpec.spec)
+        , ("Feature.RpcSpec"                , Feature.RpcSpec.spec)
+        , ("Feature.RangeSpec"              , Feature.RangeSpec.spec)
+        , ("Feature.SingularSpec"           , Feature.SingularSpec.spec)
+        , ("Feature.StructureSpec"          , Feature.StructureSpec.spec)
+        , ("Feature.AndOrParamsSpec"        , Feature.AndOrParamsSpec.spec)
+        , ("Feature.NonexistentSchemaSpec"  , Feature.NonexistentSchemaSpec.spec)
+        ] ++ pg96spec
+
   hspec $ do
     mapM_ (beforeAll_ reset . before withApp) specs
 
@@ -70,20 +101,14 @@ main = do
     beforeAll_ reset . before binaryJwtApp $
       describe "Feature.BinaryJwtSecretSpec" Feature.BinaryJwtSecretSpec.spec
 
+    -- this test runs with a binary JWT secret and an audience claim
+    beforeAll_ reset . before audJwtApp $
+      describe "Feature.AudienceJwtSecretSpec" Feature.AudienceJwtSecretSpec.spec
+
     -- this test runs with asymmetric JWK
     beforeAll_ reset . before asymJwkApp $
       describe "Feature.AsymmetricJwtSpec" Feature.AsymmetricJwtSpec.spec
 
- where
+    -- this test runs with a nonexistent db-schema
-  specs = map (uncurry describe) [
+    beforeAll_ reset . before nonexistentSchemaApp $
-      ("Feature.AuthSpec"         , Feature.AuthSpec.spec)
+      describe "Feature.NonexistentSchemaSpec" Feature.NonexistentSchemaSpec.spec
-    , ("Feature.ConcurrentSpec"   , Feature.ConcurrentSpec.spec)
-    , ("Feature.CorsSpec"         , Feature.CorsSpec.spec)
-    , ("Feature.DeleteSpec"       , Feature.DeleteSpec.spec)
-    , ("Feature.InsertSpec"       , Feature.InsertSpec.spec)
-    , ("Feature.QuerySpec"        , Feature.QuerySpec.spec)
-    , ("Feature.RangeSpec"        , Feature.RangeSpec.spec)
-    , ("Feature.SingularSpec"     , Feature.SingularSpec.spec)
-    , ("Feature.StructureSpec"    , Feature.StructureSpec.spec)
-    , ("Feature.AndOrParamsSpec"  , Feature.AndOrParamsSpec.spec)
-    ]

test/SpecHelper.hs

@@ -68,7 +68,7 @@ _baseCfg :: AppConfig
 _baseCfg =  -- Connection Settings
   AppConfig mempty "postgrest_test_anonymous" Nothing "test" "localhost" 3000
             -- Jwt settings
-            (Just $ encodeUtf8 "reallyreallyreallyreallyverysafe") False
+            (Just $ encodeUtf8 "reallyreallyreallyreallyverysafe") False Nothing
             -- Connection Modifiers
             10 Nothing (Just "test.switch_role")
             -- Debug Settings
@@ -95,12 +95,22 @@ testCfgBinaryJWT testDbConn = (testCfg testDbConn) {
       "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU="
   }
 
+testCfgAudienceJWT :: Text -> AppConfig
+testCfgAudienceJWT testDbConn = (testCfg testDbConn) {
+    configJwtSecret = Just . B64.decodeLenient $
+      "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU=",
+    configJwtAudience = Just "youraudience"
+  }
+
 testCfgAsymJWK :: Text -> AppConfig
 testCfgAsymJWK testDbConn = (testCfg testDbConn) {
     configJwtSecret = Just $ encodeUtf8
       [str|{"alg":"RS256","e":"AQAB","key_ops":["verify"],"kty":"RSA","n":"0etQ2Tg187jb04MWfpuogYGV75IFrQQBxQaGH75eq_FpbkyoLcEpRUEWSbECP2eeFya2yZ9vIO5ScD-lPmovePk4Aa4SzZ8jdjhmAbNykleRPCxMg0481kz6PQhnHRUv3nF5WP479CnObJKqTVdEagVL66oxnX9VhZG9IZA7k0Th5PfKQwrKGyUeTGczpOjaPqbxlunP73j9AfnAt4XCS8epa-n3WGz1j-wfpr_ys57Aq-zBCfqP67UYzNpeI1AoXsJhD9xSDOzvJgFRvc3vm2wjAW4LEMwi48rCplamOpZToIHEPIaPzpveYQwDnB1HFTR1ove9bpKJsHmi-e2uzQ","use":"sig"}|]
   }
 
+testNonexistentSchemaCfg :: Text -> AppConfig
+testNonexistentSchemaCfg testDbConn = (testCfg testDbConn) { configSchema = "nonexistent" }
+
 setupDb :: Text -> IO ()
 setupDb dbConn = do
   loadFixture dbConn "database"

test/fixtures/data.sql

@@ -248,7 +248,9 @@ INSERT INTO nullable_integer VALUES (NULL);
 TRUNCATE TABLE tsearch CASCADE;
 INSERT INTO tsearch VALUES (to_tsvector('It''s kind of fun to do the impossible'));
 INSERT INTO tsearch VALUES (to_tsvector('But also fun to do what is possible'));
-
+INSERT INTO tsearch VALUES (to_tsvector('Fat cats ate rats'));
+INSERT INTO tsearch VALUES (to_tsvector('french', 'C''est un peu amusant de faire l''impossible'));
+INSERT INTO tsearch VALUES (to_tsvector('german', 'Es ist eine Art Spaß, das Unmögliche zu machen')); 
 
 --
 -- Data for Name: users_projects; Type: TABLE DATA; Schema: test; Owner: -
@@ -321,6 +323,17 @@ INSERT INTO ranges VALUES (2, '[3,6]');
 INSERT INTO ranges VALUES (3, '[6,9]');
 INSERT INTO ranges VALUES (4, '[9,12]');
 
+TRUNCATE TABLE being CASCADE;
+INSERT INTO being VALUES (1), (2), (3), (4);
+
+TRUNCATE TABLE descendant CASCADE;
+INSERT INTO descendant VALUES (1,1), (2,1), (3,1), (4,2);
+
+TRUNCATE TABLE part CASCADE;
+INSERT INTO part VALUES (1), (2), (3), (4);
+
+TRUNCATE TABLE being_part CASCADE;
+INSERT INTO being_part VALUES (1,1), (2,1), (3,2), (4,3);
 --
 -- PostgreSQL database dump complete
 --

test/fixtures/privileges.sql

@@ -57,6 +57,10 @@ GRANT ALL ON TABLE
     , child_entities
     , grandchild_entities
     , ranges
+    , being
+    , descendant
+    , being_part
+    , part
 TO postgrest_test_anonymous;
 
 GRANT INSERT ON TABLE insertonly TO postgrest_test_anonymous;
@@ -74,3 +78,6 @@ GRANT ALL ON TABLE authors_only TO postgrest_test_author;
 GRANT SELECT (article_id, user_id) ON TABLE limited_article_stars TO postgrest_test_anonymous;
 GRANT INSERT (article_id, user_id) ON TABLE limited_article_stars TO postgrest_test_anonymous;
 GRANT UPDATE (article_id, user_id) ON TABLE limited_article_stars TO postgrest_test_anonymous;
+
+REVOKE EXECUTE ON FUNCTION privileged_hello(text) FROM PUBLIC; -- All functions are available to every role(PUBLIC) by default
+GRANT EXECUTE ON FUNCTION privileged_hello(text) TO postgrest_test_author;

test/fixtures/schema.sql

@@ -1096,6 +1096,12 @@ CREATE FUNCTION getproject(id int) RETURNS SETOF projects
     SELECT * FROM test.projects WHERE id = $1;
 $_$;
 
+CREATE FUNCTION get_projects_below(id int) RETURNS SETOF projects
+    LANGUAGE sql
+    AS $_$
+    SELECT * FROM test.projects WHERE id < $1;
+$_$;
+
 CREATE FUNCTION getallprojects() RETURNS SETOF projects
     LANGUAGE sql
     AS $_$
@@ -1241,6 +1247,91 @@ create function test.test() returns table(test text, value int) as $$
   values ('hello', 1);
 $$ language sql;
 
+create function test.privileged_hello(name text) returns text as $$
+  select 'Privileged hello to ' || $1;
+$$ language sql;
+
+create function test.get_tsearch() returns setof test.tsearch AS $$
+  SELECT * FROM test.tsearch;
+$$ language sql;
+
+create table test.being (
+  being int primary key not null
+);
+
+create table test.descendant (
+  descendant int primary key not null,
+  being int references test.being(being)
+);
+
+create table test.part (
+  part int primary key not null
+);
+
+create table test.being_part (
+  being int not null references test.being(being),
+  part int not null references test.part(part)
+);
+
+create function test.single_out_param(num int, OUT num_plus_one int) AS $$
+  select num + 1;
+$$ language sql;
+
+create function test.single_json_out_param(a int, b text, OUT my_json pg_catalog.json) AS $$
+  select json_build_object('a', a, 'b', b);
+$$ language sql;
+
+create function test.many_out_params(OUT my_json pg_catalog.json, OUT num int, OUT str text) AS $$
+  select '{"a": 1, "b": "two"}'::json, 3, 'four'::text;
+$$ language sql;
+
+create function test.single_inout_param(INOUT num int) AS $$
+  select num + 1;
+$$ language sql;
+
+create function test.many_inout_params(INOUT num int, INOUT str text, INOUT b bool DEFAULT true) AS $$
+  select num, str, b;
+$$ language sql;
+
+create or replace function test.raise_pt402() returns void as $$
+begin
+  raise sqlstate 'PT402' using message = 'Payment Required',
+                               detail = 'Quota exceeded',
+                               hint = 'Upgrade your plan';
+end;
+$$ language plpgsql;
+
+create or replace function test.raise_bad_pt() returns void as $$
+begin
+  raise sqlstate 'PT40A' using message = 'Wrong';
+end;
+$$ language plpgsql;
+
+create or replace function test.get_projects_and_guc_headers() returns setof test.projects as $$
+  set local "response.headers" = '[{"X-Test": "key1=val1; someValue; key2=val2"}, {"X-Test-2": "key1=val1"}]';
+  select * from test.projects;
+$$ language sql;
+
+create or replace function test.get_int_and_guc_headers(num int) returns integer as $$
+  set local "response.headers" = '[{"X-Test":"key1=val1; someValue; key2=val2"},{"X-Test-2":"key1=val1"}]';
+  select num;
+$$ language sql;
+
+create or replace function test.bad_guc_headers_1() returns void as $$
+  set local "response.headers" = '{"X-Test": "invalid structure for headers"}';
+$$ language sql;
+
+create or replace function test.bad_guc_headers_2() returns void as $$
+  set local "response.headers" = '["invalid", "structure", "for", "headers"]';
+$$ language sql;
+
+create or replace function test.bad_guc_headers_3() returns void as $$
+  set local "response.headers" = '{"X-Test": "invalid", "X-Test-2": "structure", "X-Test-3": "for headers"}';
+$$ language sql;
+
+create or replace function test.set_cookie_twice() returns void as $$
+  set local "response.headers" = '[{"Set-Cookie": "sessionid=38afes7a8; HttpOnly; Path=/"}, {"Set-Cookie": "id=a3fWa; Expires=Wed, 21 Oct 2015 07:28:00 GMT; Secure; HttpOnly"}]';
+$$ language sql;
 --
 -- PostgreSQL database dump complete
 --

test/io-tests.sh

@@ -93,13 +93,13 @@ totalTests=12
 echo "1..$totalTests"
 
 readSecretFromFile word.noeol 'simple (no EOL)'
-skip readSecretFromFile word.txt 'simple'
+readSecretFromFile word.txt 'simple'
 readSecretFromFile ascii.noeol 'ASCII (no EOL)'
-skip readSecretFromFile ascii.txt 'ASCII'
+readSecretFromFile ascii.txt 'ASCII'
 readSecretFromFile utf8.noeol 'UTF-8 (no EOL)'
-skip readSecretFromFile utf8.txt 'UTF-8'
+readSecretFromFile utf8.txt 'UTF-8'
-skip readSecretFromFile binary.noeol 'binary'
+readSecretFromFile binary.noeol 'binary'
-skip readSecretFromFile binary.eol 'binary (+EOL)'
+readSecretFromFile binary.eol 'binary (+EOL)'
 
 readSecretFromFile word.b64 'Base64 (simple)'
 readSecretFromFile ascii.b64 'Base64 (ASCII)'