postgrest 5.1.0 → 5.2.0

raw patch · 32 files changed

+511/−318 lines, 32 filesdep ~hasqldep ~hasql-pooldep ~hasql-transactionPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hasql, hasql-pool, hasql-transaction

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• main/Main.hs +47/−32
• postgrest.cabal +11/−8
• src/PostgREST/ApiRequest.hs +4/−5
• src/PostgREST/App.hs +14/−14
• src/PostgREST/Auth.hs +22/−12
• src/PostgREST/Config.hs +14/−18
• src/PostgREST/DbRequestBuilder.hs +6/−6
• src/PostgREST/DbStructure.hs +149/−140
• src/PostgREST/Error.hs +7/−4
• src/PostgREST/Middleware.hs +6/−6
• src/PostgREST/OpenAPI.hs +1/−1
• src/PostgREST/Parsers.hs +14/−14
• src/PostgREST/QueryBuilder.hs +24/−20
• src/PostgREST/RangeQuery.hs +3/−4
• src/PostgREST/Types.hs +20/−1
• test/Feature/AndOrParamsSpec.hs +1/−1
• test/Feature/AsymmetricJwtSpec.hs +1/−1
• test/Feature/BinaryJwtSecretSpec.hs +1/−1
• test/Feature/ConcurrentSpec.hs +1/−1
• test/Feature/CorsSpec.hs +2/−2
• test/Feature/ExtraSearchPathSpec.hs +37/−0
• test/Feature/NoJwtSpec.hs +1/−1
• test/Feature/PgVersion95Spec.hs +1/−1
• test/Feature/PgVersion96Spec.hs +1/−1
• test/Feature/ProxySpec.hs +2/−2
• test/Feature/QueryLimitedSpec.hs +1/−1
• test/Feature/QuerySpec.hs +56/−1
• test/Feature/RpcSpec.hs +6/−1
• test/Feature/StructureSpec.hs +1/−1
• test/Main.hs +25/−13
• test/SpecHelper.hs +15/−5

@@ -9,6 +9,23 @@  ### Fixed +## [5.2.0] - 2018-12-12++### Added++- #1205, Add support for parsing JSON Web Key Sets - @russelldavies+- #1203, Add support for reading db-uri from a separate file - @zhoufeng1989+- #1200, Add db-extra-search-path config for adding schemas to the search_path, solves issues related to extensions created on the public schema - @steve-chavez+- #1219, Add ability to quote column names on filters - @steve-chavez++### Fixed++- #1182, Fix embedding on views with composite pks - @steve-chavez+- #1180, Fix embedding on views with subselects in pg10 - @steve-chavez+- #1197, Allow CORS for PUT - @bkylerussell+- #1181, Correctly qualify function argument of custom type in public schema - @steve-chavez+- #1008, Allow columns that contain spaces in filters - @steve-chavez+ ## [5.1.0] - 2018-08-31  ### Added

@@ -3,38 +3,38 @@ module Main where  -import           PostgREST.App            (postgrest)-import           PostgREST.Config         (AppConfig (..),-                                           minimumPgVersion,-                                           prettyVersion, readOptions)-import           PostgREST.DbStructure    (getDbStructure, getPgVersion)-import           PostgREST.Error          (encodeError)-import           PostgREST.OpenAPI        (isMalformedProxyUri)-import           PostgREST.Types          (DbStructure, Schema, PgVersion(..))-import           Protolude                hiding (hPutStrLn, replace)+import           PostgREST.App              (postgrest)+import           PostgREST.Config           (AppConfig (..),+                                             prettyVersion, readOptions)+import           PostgREST.DbStructure      (getDbStructure, getPgVersion)+import           PostgREST.Error            (encodeError)+import           PostgREST.OpenAPI          (isMalformedProxyUri)+import           PostgREST.Types            (DbStructure, Schema, PgVersion(..), minimumPgVersion)+import           Protolude                  hiding (hPutStrLn, replace)  -import           Control.AutoUpdate       (defaultUpdateSettings,-                                           mkAutoUpdate, updateAction)-import           Control.Retry            (RetryStatus, capDelay,-                                           exponentialBackoff,-                                           retrying, rsPreviousDelay)-import qualified Data.ByteString          as BS-import qualified Data.ByteString.Base64   as B64-import           Data.IORef               (IORef, atomicWriteIORef,-                                           newIORef, readIORef)-import           Data.String              (IsString (..))-import           Data.Text                (pack, replace, stripPrefix, strip)-import           Data.Text.Encoding       (decodeUtf8, encodeUtf8)-import           Data.Text.IO             (hPutStrLn)-import           Data.Time.Clock          (getCurrentTime)-import qualified Hasql.Pool               as P-import qualified Hasql.Session            as H-import           Network.Wai.Handler.Warp (defaultSettings,-                                           runSettings, setHost,-                                           setPort, setServerName)-import           System.IO                (BufferMode (..),-                                           hSetBuffering)+import           Control.AutoUpdate         (defaultUpdateSettings,+                                             mkAutoUpdate, updateAction)+import           Control.Retry              (RetryStatus, capDelay,+                                             exponentialBackoff,+                                             retrying, rsPreviousDelay)+import qualified Data.ByteString            as BS+import qualified Data.ByteString.Base64     as B64+import           Data.IORef                 (IORef, atomicWriteIORef,+                                             newIORef, readIORef)+import           Data.String                (IsString (..))+import           Data.Text                  (pack, replace, stripPrefix, strip)+import           Data.Text.Encoding         (decodeUtf8, encodeUtf8)+import           Data.Text.IO               (hPutStrLn, readFile)+import           Data.Time.Clock            (getCurrentTime)+import qualified Hasql.Pool                 as P+import qualified Hasql.Session              as H+import qualified Hasql.Transaction.Sessions as HT+import           Network.Wai.Handler.Warp   (defaultSettings,+                                             runSettings, setHost,+                                             setPort, setServerName)+import           System.IO                  (BufferMode (..),+                                             hSetBuffering)  #ifndef mingw32_HOST_OS import           System.Posix.Signals@@ -83,7 +83,7 @@               ("Cannot run in this PostgreSQL version, PostgREST needs at least "               <> pgvName minimumPgVersion)             killThread mainTid-          dbStructure <- getDbStructure schema actualPgVersion+          dbStructure <- HT.transaction HT.ReadCommitted HT.Read $ getDbStructure schema actualPgVersion           liftIO $ atomicWriteIORef refDbStructure $ Just dbStructure         case result of           Left e -> do@@ -139,7 +139,7 @@   --   -- readOptions builds the 'AppConfig' from the config file specified on the   -- command line-  conf <- loadSecretFile =<< readOptions+  conf <- loadDbUriFile =<< loadSecretFile =<< readOptions   let host = configHost conf       port = configPort conf       proxy = configProxyUri conf@@ -278,3 +278,18 @@     -- replace: Replace every occurrence of one substring with another     replaceUrlChars =       replace "_" "/" . replace "-" "+" . replace "." "="++{-+  Load database uri from a separate file if `db-uri` is a filepath.+-}+loadDbUriFile :: AppConfig -> IO AppConfig+loadDbUriFile conf = extractDbUri mDbUri+  where+    mDbUri = configDatabase conf+    extractDbUri :: Text -> IO AppConfig+    extractDbUri dbUri =+      fmap setDbUri $+      case stripPrefix "@" dbUri of+        Nothing -> return dbUri+        Just filename -> strip <$> readFile (toS filename)+    setDbUri dbUri = conf {configDatabase = dbUri}

@@ -2,7 +2,7 @@ description:           Reads the schema of a PostgreSQL database and creates RESTful routes                        for the tables and views, supporting all HTTP verbs that security                        permits.-version:               5.1.0+version:               5.2.0 synopsis:              REST API for any Postgres database license:               MIT license-file:          LICENSE@@ -33,8 +33,9 @@   default-language:    Haskell2010   build-depends:       auto-update                      , base >= 4.8 && < 4.10-                     , hasql == 1.1-                     , hasql-pool == 0.4.3+                     , hasql >= 1.3 && < 1.4+                     , hasql-pool >= 0.5 && < 0.6+                     , hasql-transaction >= 0.7 && < 0.8                      , postgrest                      , protolude == 0.2.2                      , text@@ -64,9 +65,9 @@                      , contravariant-extras                      , either                      , gitrev-                     , hasql == 1.1-                     , hasql-pool == 0.4.3-                     , hasql-transaction == 0.5.2+                     , hasql >= 1.3 && < 1.4+                     , hasql-pool >= 0.5 && < 0.6+                     , hasql-transaction >= 0.7 && < 0.8                      , heredoc                      , HTTP                      , http-types@@ -123,6 +124,7 @@                      , Feature.ConcurrentSpec                      , Feature.CorsSpec                      , Feature.DeleteSpec+                     , Feature.ExtraSearchPathSpec                      , Feature.InsertSpec                      , Feature.JsonOperatorSpec                      , Feature.NoJwtSpec@@ -152,8 +154,9 @@                      , cassava                      , containers                      , contravariant-                     , hasql == 1.1-                     , hasql-pool == 0.4.3+                     , hasql >= 1.3 && < 1.4+                     , hasql-pool >= 0.5 && < 0.6+                     , hasql-transaction >= 0.7 && < 0.8                      , heredoc                      , hjsonschema == 1.5.0.1                      , hspec

@@ -110,8 +110,7 @@       iAction = action       , iTarget = target       , iRange = ranges-      , iAccepts = fromMaybe [CTAny] $-        map decodeContentType . parseHttpAccept <$> lookupHeader "accept"+      , iAccepts = maybe [CTAny] (map decodeContentType . parseHttpAccept) $ lookupHeader "accept"       , iPayload = relevantPayload       , iPreferRepresentation = representation       , iPreferSingleObjectParameter = singleObject@@ -130,7 +129,7 @@         $ rawQueryString req       , iJWT = tokenStr       , iHeaders = [ (toS $ CI.foldedCase k, toS v) | (k,v) <- hdrs, k /= hAuthorization, k /= hCookie]-      , iCookies = fromMaybe [] $ parseCookiesText <$> lookupHeader "Cookie"+      , iCookies = maybe [] parseCookiesText $ lookupHeader "Cookie"       }  where   -- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)@@ -143,7 +142,7 @@                       ((<> ".") <$> "not":M.keys operators) ++                       ((<> "(") <$> M.keys ftsOperators)   isEmbedPath = T.isInfixOf "."-  isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path+  isTargetingProc = (== Just "rpc") $ listToMaybe path   payload =     case (decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type", action) of       (_, ActionInvoke{isReadOnly=True}) ->@@ -215,7 +214,7 @@   limitParams :: M.HashMap ByteString NonnegRange   limitParams  = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe =<< (toS <$> v)) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k]   offsetParams :: M.HashMap ByteString NonnegRange-  offsetParams = M.fromList [(toS (replaceLast "limit" k), fromMaybe allRange (rangeGeq <$> (readMaybe =<< (toS <$> v)))) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]+  offsetParams = M.fromList [(toS (replaceLast "limit" k), maybe allRange rangeGeq (readMaybe =<< (toS <$> v))) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]    urlRange = M.unionWith f limitParams offsetParams     where

@@ -35,7 +35,7 @@                                         , mutuallyAgreeable                                         , userApiRequest                                         )-import           PostgREST.Auth            (jwtClaims, containsRole, parseJWK)+import           PostgREST.Auth            (jwtClaims, containsRole, parseSecret) import           PostgREST.Config          (AppConfig (..)) import           PostgREST.DbStructure import           PostgREST.DbRequestBuilder( readRequest@@ -65,7 +65,7 @@ postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> IO () -> Application postgrest conf refDbStructure pool getTime worker =   let middle = (if configQuiet conf then id else logStdout) . defaultMiddle-      jwtSecret = parseJWK <$> configJwtSecret conf in+      jwtSecret = parseSecret <$> configJwtSecret conf in    middle $ \ req respond -> do     time <- getTime@@ -102,14 +102,14 @@              else payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> pdArgs x))   ) <$> procs -transactionMode :: Maybe ProcDescription -> Action -> H.Mode+transactionMode :: Maybe ProcDescription -> Action -> HT.Mode transactionMode proc action =   case action of     ActionRead -> HT.Read     ActionInfo -> HT.Read     ActionInspect -> HT.Read     ActionInvoke{isReadOnly=False} ->-      let v = fromMaybe Volatile $ pdVolatility <$> proc in+      let v = maybe Volatile  pdVolatility proc in       if v == Stable || v == Immutable          then HT.Read          else HT.Write@@ -131,7 +131,7 @@             Right ((q, cq), bField) -> do               let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount                                             (contentType == CTTextCSV) bField-              row <- H.query () stm+              row <- H.statement () stm               let (tableTotal, queryTotal, _ , body) = row                   (status, contentRange) = rangeHeader queryTotal tableTotal                   canonical = iCanonicalQS apiRequest@@ -162,7 +162,7 @@                       stm = createWriteStatement sq mq                         (contentType == CTSingularJSON) isSingle                         (contentType == CTTextCSV) (iPreferRepresentation apiRequest) pkCols-                  row <- H.query (toS pjRaw) stm+                  row <- H.statement (toS pjRaw) stm                   let (_, _, fs, body) = extractQueryResult row                       headers = catMaybes [                           if null fs@@ -191,7 +191,7 @@               let stm = createWriteStatement sq mq                     (contentType == CTSingularJSON) False (contentType == CTTextCSV)                     (iPreferRepresentation apiRequest) []-              row <- H.query (toS pjRaw) stm+              row <- H.statement (toS pjRaw) stm               let (_, queryTotal, _, body) = extractQueryResult row               if contentType == CTSingularJSON                  && queryTotal /= 1@@ -224,7 +224,7 @@               else if S.fromList colNames /= pjKeys                 then return $ simpleError status400 [] "You must specify all columns in the payload when using PUT"               else do-                row <- H.query (toS pjRaw) $+                row <- H.statement (toS pjRaw) $                        createWriteStatement sq mq (contentType == CTSingularJSON) False                                             (contentType == CTTextCSV) (iPreferRepresentation apiRequest) []                 let (_, queryTotal, _, body) = extractQueryResult row@@ -248,7 +248,7 @@                     (contentType == CTSingularJSON) False                     (contentType == CTTextCSV)                     (iPreferRepresentation apiRequest) []-              row <- H.query mempty stm+              row <- H.statement mempty stm               let (_, queryTotal, _, body) = extractQueryResult row                   r = contentRangeH 1 0 $                         toInteger <$> if shouldCount then Just queryTotal else Nothing@@ -286,8 +286,8 @@                                 PJObject  -> True                                 PJArray _ -> False                   singular = contentType == CTSingularJSON-                  specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ fromMaybe [] (pdArgs <$> proc)-              row <- H.query (toS pjRaw) $+                  specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ maybe [] pdArgs proc+              row <- H.statement (toS pjRaw) $                 callProc qi specifiedPgArgs returnsScalar q cq shouldCount                          singular (iPreferSingleObjectParameter apiRequest)                          (contentType == CTTextCSV)@@ -316,7 +316,7 @@               toTableInfo :: [Table] -> [(Table, [Column], [Text])]               toTableInfo = map (\t -> let (s, tn) = (tableSchema t, tableName t) in (t, tableCols dbStructure s tn, tablePKCols dbStructure s tn))               encodeApi ti sd procs = encodeOpenAPI (concat $ M.elems procs) (toTableInfo ti) uri' sd $ dbPrimaryKeys dbStructure-          body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription <*> H.query schema accessibleProcs+          body <- encodeApi <$> H.statement schema accessibleTables <*> H.statement schema schemaDescription <*> H.statement schema accessibleProcs           return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body          _ -> return notFound@@ -397,8 +397,8 @@       rangeString         | totalNotZero && fromInRange = show lower <> "-" <> show upper         | otherwise = "*"-      totalString   = fromMaybe "*" (show <$> total)-      totalNotZero  = fromMaybe True ((/=) 0 <$> total)+      totalString   = maybe "*" show total+      totalNotZero  = maybe True (0 /=) total       fromInRange   = lower <= upper  extractQueryResult :: Maybe ResultsWithCount -> ResultsWithCount

@@ -16,7 +16,7 @@     containsRole   , jwtClaims   , JWTAttempt(..)-  , parseJWK+  , parseSecret   ) where  import           Control.Lens.Operators@@ -43,7 +43,7 @@   Receives the JWT secret and audience (from config) and a JWT and returns a map   of JWT claims. -}-jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString -> UTCTime -> Maybe JSPath -> IO JWTAttempt+jwtClaims :: Maybe JWKSet -> Maybe StringOrURI -> LByteString -> UTCTime -> Maybe JSPath -> IO JWTAttempt jwtClaims _ _ "" _ _ = return $ JWTClaims M.empty jwtClaims secret audience payload time jspath =   case secret of@@ -83,19 +83,29 @@ containsRole (JWTClaims claims) = M.member "role" claims containsRole _                  = False -parseJWK :: ByteString -> JWK-parseJWK str =-  fromMaybe (hs256jwk str) (JSON.decode (toS str) :: Maybe JWK)+{-|+  Parse `jwt-secret` configuration option and turn into a JWKSet. +  There are three ways to specify `jwt-secret`: text secret, JSON Web Key+  (JWK), or JSON Web Key Set (JWKS). The first two are converted into a JWKSet+  with one key and the last is converted as is.+-}+parseSecret :: ByteString -> JWKSet+parseSecret str =+  fromMaybe (maybe secret (\jwk' -> JWKSet [jwk']) maybeJWK)+    maybeJWKSet+ where+  maybeJWKSet = JSON.decode (toS str) :: Maybe JWKSet+  maybeJWK = JSON.decode (toS str) :: Maybe JWK+  secret = JWKSet [jwkFromSecret str]+ {-|-  Internal helper to generate HMAC-SHA256. When the jwt key in the-  config file is a simple string rather than a JWK object, we'll-  apply this function to it.+  Internal helper to generate a symmetric HMAC-SHA256 JWK from a text secret. -}-hs256jwk :: ByteString -> JWK-hs256jwk key =+jwkFromSecret :: ByteString -> JWK+jwkFromSecret key =   fromKeyMaterial km-    & jwkUse .~ Just Sig-    & jwkAlg .~ (Just $ JWSAlg HS256)+    & jwkUse ?~ Sig+    & jwkAlg ?~ JWSAlg HS256  where   km = OctKeyMaterial (OctKeyParameters (JOSE.Types.Base64Octets key))

@@ -18,9 +18,6 @@                         , docsVersion                         , readOptions                         , corsPolicy-                        , minimumPgVersion-                        , pgVersion95-                        , pgVersion96                         , AppConfig (..)                         )        where@@ -42,7 +39,7 @@ import           Data.String                  (String) import           Data.Text                    (dropAround,                                                intercalate, lines,-                                               strip, take)+                                               strip, take, splitOn) import           Data.Text.Encoding           (encodeUtf8) import           Data.Text.IO                 (hPutStrLn) import           Data.Version                 (versionBranch)@@ -52,7 +49,7 @@ import           Options.Applicative          hiding (str) import           Paths_postgrest              (version) import           PostgREST.Parsers            (pRoleClaimKey)-import           PostgREST.Types              (PgVersion(..), ApiRequestError(..),+import           PostgREST.Types              (ApiRequestError(..),                                                JSPath, JSPathExp(..)) import           Protolude                    hiding (hPutStrLn, take,                                                intercalate, (<>))@@ -81,11 +78,12 @@   , configQuiet             :: Bool   , configSettings          :: [(Text, Text)]   , configRoleClaimKey      :: Either ApiRequestError JSPath+  , configExtraSearchPath   :: [Text]   }  defaultCorsPolicy :: CorsResourcePolicy defaultCorsPolicy =  CorsResourcePolicy Nothing-  ["GET", "POST", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing+  ["GET", "POST", "PATCH", "PUT", "DELETE", "OPTIONS"] ["Authorization"] Nothing   (Just $ 60*60*24) False False True  -- | CORS policy to be used in by Wai Cors middleware@@ -143,6 +141,7 @@           <*> pure False           <*> (fmap (fmap coerceText) <$> C.subassocs "app.settings")           <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> C.key "role-claim-key")+          <*> (maybe ["public"] splitExtraSearchPath <$> C.key "db-extra-search-path")    case mAppConf of     Nothing -> do@@ -179,6 +178,10 @@     parseRoleClaimKey (String s) = pRoleClaimKey s     parseRoleClaimKey v = pRoleClaimKey $ show v +    splitExtraSearchPath :: Value -> [Text]+    splitExtraSearchPath (String s) = strip <$> splitOn "," s+    splitExtraSearchPath _ = []+     opts = info (helper <*> pathParser) $              fullDesc              <> progDesc (@@ -202,7 +205,7 @@     exampleCfg :: Doc     exampleCfg = vsep . map (text . toS) . lines $       [str|db-uri = "postgres://user:pass@localhost:5432/dbname"-          |db-schema = "public"+          |db-schema = "public" # this schema gets added to the search_path of every request           |db-anon-role = "postgres"           |db-pool = 10           |@@ -212,7 +215,7 @@           |## base url for swagger output           |# server-proxy-uri = ""           |-          |## choose a secret to enable JWT auth+          |## choose a secret, JSON Web Key (or set) to enable JWT auth           |## (use "@filename" to load from separate file)           |# jwt-secret = "foo"           |# secret-is-base64 = false@@ -226,6 +229,9 @@           |           |## jspath to the role claim key           |# role-claim-key = ".role"+          |+          |## extra schemas to add to the search_path of every request+          |# db-extra-search-path = "extensions, util"           |]  pathParser :: Parser FilePath@@ -233,13 +239,3 @@   strArgument $     metavar "FILENAME" <>     help "Path to configuration file"---- | Tells the minimum PostgreSQL version required by this version of PostgREST-minimumPgVersion :: PgVersion-minimumPgVersion = PgVersion 90400 "9.4"--pgVersion96 :: PgVersion-pgVersion96 = PgVersion 90600 "9.6"--pgVersion95 :: PgVersion-pgVersion95 = PgVersion 90500 "9.5"

@@ -36,7 +36,7 @@ import           PostgREST.RangeQuery      (NonnegRange, restrictRange, allRange) import           PostgREST.Types -import           Protolude                hiding (from, dropWhile, drop)+import           Protolude                hiding (from) import           Text.Regex.TDFA         ((=~)) import           Unsafe                  (unsafeHead) @@ -90,7 +90,7 @@ -- in a relation where one of the tables matches "TableName" -- replace the name to that table with pg_source -- this "fake" relations is needed so that in a mutate query--- we can look a the "returning *" part which is wrapped with a "with"+-- we can look at the "returning *" part which is wrapped with a "with" -- as just another table that has relations with other tables toSourceRelation :: TableName -> Relation -> Maybe Relation toSourceRelation mt r@(Relation t _ ft _ _ rt _ _)@@ -225,12 +225,12 @@     addJoinCond jc rq@Select{joinConditions=jcs} = rq{joinConditions=jc:jcs}  getJoinConditions :: Relation -> [JoinCondition]-getJoinConditions (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fcs typ lt lc1 lc2) =+getJoinConditions (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fCols typ lt lc1 lc2) =   if | typ == Child || typ == Parent ->-        zipWith (toJoinCondition tN ftN) cols fcs+        zipWith (toJoinCondition tN ftN) cols fCols      | typ == Many ->-        let ltN = fromMaybe "" (tableName <$> lt) in-        zipWith (toJoinCondition tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toJoinCondition ftN ltN) fcs (fromMaybe [] lc2)+        let ltN = maybe "" tableName lt in+        zipWith (toJoinCondition tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toJoinCondition ftN ltN) fCols (fromMaybe [] lc2)      | typ == Root -> witness   where     toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition

@@ -14,7 +14,7 @@  import qualified Hasql.Decoders                as HD import qualified Hasql.Encoders                as HE-import qualified Hasql.Query                   as H+import qualified Hasql.Statement               as H  import           Control.Applicative import qualified Data.HashMap.Strict           as M@@ -25,23 +25,25 @@                                                 splitOn) import qualified Data.Text                     as T import qualified Hasql.Session                 as H+import qualified Hasql.Transaction             as HT import           PostgREST.Types-import           Text.InterpolatedString.Perl6 (q)+import           Text.InterpolatedString.Perl6 (q, qc)  import           GHC.Exts                      (groupWith) import           Protolude import           Unsafe (unsafeHead) -getDbStructure :: Schema -> PgVersion -> H.Session DbStructure+getDbStructure :: Schema -> PgVersion -> HT.Transaction DbStructure getDbStructure schema pgVer = do-  tabs      <- H.query () allTables-  cols      <- H.query schema $ allColumns tabs-  syns      <- H.query schema $ allSynonyms cols-  childRels <- H.query () $ allChildRelations tabs cols-  keys      <- H.query () $ allPrimaryKeys tabs-  procs     <- H.query schema allProcs+  HT.sql "set local schema ''" -- for getting the fully qualified name(schema.name) of every db object+  tabs      <- HT.statement () allTables+  cols      <- HT.statement schema $ allColumns tabs+  syns      <- HT.statement schema $ allSynonyms cols pgVer+  childRels <- HT.statement () $ allChildRelations tabs cols+  keys      <- HT.statement () $ allPrimaryKeys tabs+  procs     <- HT.statement schema allProcs -  let rels = addManyToManyRelations . addParentRelations $ addViewRelations syns childRels+  let rels = addManyToManyRelations . addParentRelations $ addViewChildRelations syns childRels       cols' = addForeignKeys rels cols       keys' = addViewPrimaryKeys syns keys @@ -56,70 +58,70 @@  decodeTables :: HD.Result [Table] decodeTables =-  HD.rowsList tblRow+  HD.rowList tblRow  where-  tblRow = Table <$> HD.value HD.text-                 <*> HD.value HD.text-                 <*> HD.nullableValue HD.text-                 <*> HD.value HD.bool+  tblRow = Table <$> HD.column HD.text+                 <*> HD.column HD.text+                 <*> HD.nullableColumn HD.text+                 <*> HD.column HD.bool  decodeColumns :: [Table] -> HD.Result [Column] decodeColumns tables =-  mapMaybe (columnFromRow tables) <$> HD.rowsList colRow+  mapMaybe (columnFromRow tables) <$> HD.rowList colRow  where   colRow =     (,,,,,,,,,,,)-      <$> HD.value HD.text <*> HD.value HD.text-      <*> HD.value HD.text <*> HD.nullableValue HD.text-      <*> HD.value HD.int4 <*> HD.value HD.bool-      <*> HD.value HD.text <*> HD.value HD.bool-      <*> HD.nullableValue HD.int4-      <*> HD.nullableValue HD.int4-      <*> HD.nullableValue HD.text-      <*> HD.nullableValue HD.text+      <$> HD.column HD.text <*> HD.column HD.text+      <*> HD.column HD.text <*> HD.nullableColumn HD.text+      <*> HD.column HD.int4 <*> HD.column HD.bool+      <*> HD.column HD.text <*> HD.column HD.bool+      <*> HD.nullableColumn HD.int4+      <*> HD.nullableColumn HD.int4+      <*> HD.nullableColumn HD.text+      <*> HD.nullableColumn HD.text  decodeRelations :: [Table] -> [Column] -> HD.Result [Relation] decodeRelations tables cols =-  mapMaybe (relationFromRow tables cols) <$> HD.rowsList relRow+  mapMaybe (relationFromRow tables cols) <$> HD.rowList relRow  where   relRow = (,,,,,)-    <$> HD.value HD.text-    <*> HD.value HD.text-    <*> HD.value (HD.array (HD.arrayDimension replicateM (HD.arrayValue HD.text)))-    <*> HD.value HD.text-    <*> HD.value HD.text-    <*> HD.value (HD.array (HD.arrayDimension replicateM (HD.arrayValue HD.text)))+    <$> HD.column HD.text+    <*> HD.column HD.text+    <*> HD.column (HD.array (HD.dimension replicateM (HD.element HD.text)))+    <*> HD.column HD.text+    <*> HD.column HD.text+    <*> HD.column (HD.array (HD.dimension replicateM (HD.element HD.text)))  decodePks :: [Table] -> HD.Result [PrimaryKey] decodePks tables =-  mapMaybe (pkFromRow tables) <$> HD.rowsList pkRow+  mapMaybe (pkFromRow tables) <$> HD.rowList pkRow  where-  pkRow = (,,) <$> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text+  pkRow = (,,) <$> HD.column HD.text <*> HD.column HD.text <*> HD.column HD.text  decodeSynonyms :: [Column] -> HD.Result [Synonym] decodeSynonyms cols =-  mapMaybe (synonymFromRow cols) <$> HD.rowsList synRow+  mapMaybe (synonymFromRow cols) <$> HD.rowList synRow  where   synRow = (,,,,,)-    <$> HD.value HD.text <*> HD.value HD.text-    <*> HD.value HD.text <*> HD.value HD.text-    <*> HD.value HD.text <*> HD.value HD.text+    <$> HD.column HD.text <*> HD.column HD.text+    <*> HD.column HD.text <*> HD.column HD.text+    <*> HD.column HD.text <*> HD.column HD.text  decodeProcs :: HD.Result (M.HashMap Text [ProcDescription]) decodeProcs =   -- Duplicate rows for a function means they're overloaded, order these by least args according to ProcDescription Ord instance-  map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addName) <$> HD.rowsList tblRow+  map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addName) <$> HD.rowList tblRow   where     tblRow = ProcDescription-              <$> HD.value HD.text-              <*> HD.nullableValue HD.text-              <*> (parseArgs <$> HD.value HD.text)+              <$> HD.column HD.text+              <*> HD.nullableColumn HD.text+              <*> (parseArgs <$> HD.column HD.text)               <*> (parseRetType-                  <$> HD.value HD.text-                  <*> HD.value HD.text-                  <*> HD.value HD.bool-                  <*> HD.value HD.char)-              <*> (parseVolatility <$> HD.value HD.char)+                  <$> HD.column HD.text+                  <*> HD.column HD.text+                  <*> HD.column HD.bool+                  <*> HD.column HD.char)+              <*> (parseVolatility <$> HD.column HD.char)      addName :: ProcDescription -> (Text, ProcDescription)     addName pd = (pdName pd, pd)@@ -155,11 +157,11 @@                       | 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+allProcs :: H.Statement Schema (M.HashMap Text [ProcDescription])+allProcs = H.Statement (toS procsSqlQuery) (HE.param HE.text) decodeProcs True -accessibleProcs :: H.Query Schema (M.HashMap Text [ProcDescription])-accessibleProcs = H.statement (toS sql) (HE.value HE.text) decodeProcs True+accessibleProcs :: H.Statement Schema (M.HashMap Text [ProcDescription])+accessibleProcs = H.Statement (toS sql) (HE.param HE.text) decodeProcs True   where     sql = procsSqlQuery <> " AND has_function_privilege(p.oid, 'execute')" @@ -182,9 +184,9 @@   WHERE  pn.nspname = $1 |] -schemaDescription :: H.Query Schema (Maybe Text)+schemaDescription :: H.Statement Schema (Maybe Text) schemaDescription =-    H.statement sql (HE.value HE.text) (join <$> HD.maybeRow (HD.nullableValue HD.text)) True+    H.Statement sql (HE.param HE.text) (join <$> HD.rowMaybe (HD.nullableColumn HD.text)) True   where     sql = [q|       select@@ -195,9 +197,9 @@       where         n.nspname = $1 |] -accessibleTables :: H.Query Schema [Table]+accessibleTables :: H.Statement Schema [Table] accessibleTables =-  H.statement sql (HE.value HE.text) decodeTables True+  H.Statement sql (HE.param HE.text) decodeTables True  where   sql = [q|     select@@ -243,32 +245,32 @@  t1.c1------t2.c2 -When only having a t1_view.c1 synonym, we need to add a View to Table Relation+When only having a t1_view.c1 synonym, we need to add a View to Table Child Relation           t1.c1----t2.c2         t1.c1----------t2.c2-                         ->            --------/+                         ->            ________/                                       /       t1_view.c1             t1_view.c1  -When only having a t2_view.c2 synonym, we need to add a Table to View Relation+When only having a t2_view.c2 synonym, we need to add a Table to View Child Relation           t1.c1----t2.c2               t1.c1----------t2.c2-                               ->          \--------+                               ->          \________                                                     \                     t2_view.c2                      t2_view.c1 -When having t1_view.c1 and a t2_view.c2 synonyms, we need to add a View to View Relation in addition to the prior+When having t1_view.c1 and a t2_view.c2 synonyms, we need to add a View to View Child Relation in addition to the prior           t1.c1----t2.c2               t1.c1----------t2.c2-                               ->          \--------/+                               ->          \________/                                            /        \     t1_view.c1     t2_view.c2     t1_view.c1-------t2_view.c1  The logic for composite pks is similar just need to make sure all the Relation columns have synonyms. -}-addViewRelations :: [Synonym] -> [Relation] -> [Relation]-addViewRelations allSyns = concatMap (\rel ->+addViewChildRelations :: [Synonym] -> [Relation] -> [Relation]+addViewChildRelations allSyns = concatMap (\rel ->   rel : case rel of     Relation{relType=Child, relTable, relColumns, relFTable, relFColumns} -> @@ -279,18 +281,22 @@           fColsSyns = colSynsGroupedByView relFColumns           getView :: [Synonym] -> Table           getView = colTable . snd . unsafeHead-          syns `allSynsOf` cols = S.fromList (fst <$> syns) == S.fromList cols in+          syns `allSynsOf` cols = S.fromList (fst <$> syns) == S.fromList cols+          -- Relation is dependent on the order of relColumns and relFColumns to get the join conditions right in the generated query.+          -- So we need to change the order of the synonyms to match the relColumns+          -- This could be avoided if the Relation type is improved with a structure that maintains the association of relColumns and relFColumns+          syns `sortAccordingTo` columns = sortOn (\(k, _) -> L.lookup k $ zip columns [0::Int ..]) syns in -      -- View Table Relations-      [Relation (getView syns) (snd <$> syns) relFTable relFColumns Child Nothing Nothing Nothing+      -- View Table Child Relations+      [Relation (getView syns) (snd <$> syns `sortAccordingTo` relColumns) relFTable relFColumns Child Nothing Nothing Nothing         | syns <- colsSyns, syns `allSynsOf` relColumns] ++ -      -- Table View Relations-      [Relation relTable relColumns (getView fSyns) (snd <$> fSyns) Child Nothing Nothing Nothing+      -- Table View Child Relations+      [Relation relTable relColumns (getView fSyns) (snd <$> fSyns `sortAccordingTo` relFColumns) Child Nothing Nothing Nothing         | fSyns <- fColsSyns, fSyns `allSynsOf` relFColumns] ++ -      -- View View Relations-      [Relation (getView syns) (snd <$> syns) (getView fSyns) (snd <$> fSyns) Child Nothing Nothing Nothing+      -- View View Child Relations+      [Relation (getView syns) (snd <$> syns `sortAccordingTo` relColumns) (getView fSyns) (snd <$> fSyns `sortAccordingTo` relFColumns) Child Nothing Nothing Nothing         | syns <- colsSyns, fSyns <- fColsSyns, syns `allSynsOf` relColumns, fSyns `allSynsOf` relFColumns]      _ -> [])@@ -324,9 +330,9 @@                 filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) syns in   pk : viewPks) -allTables :: H.Query () [Table]+allTables :: H.Statement () [Table] allTables =-  H.statement sql HE.unit decodeTables True+  H.Statement sql HE.unit decodeTables True  where   sql = [q|     SELECT@@ -347,9 +353,9 @@     GROUP BY table_schema, table_name, insertable     ORDER BY table_schema, table_name |] -allColumns :: [Table] -> H.Query Schema [Column]+allColumns :: [Table] -> H.Statement Schema [Column] allColumns tabs =-  H.statement sql (HE.value HE.text) (decodeColumns tabs) True+  H.Statement sql (HE.param HE.text) (decodeColumns tabs) True  where   sql = [q|     SELECT DISTINCT@@ -532,11 +538,11 @@     buildColumn tbl = Column tbl n desc pos nul typ u l p d (parseEnum e) Nothing     table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs     parseEnum :: Maybe Text -> [Text]-    parseEnum str = fromMaybe [] $ split (==',') <$> str+    parseEnum = maybe [] (split (==',')) -allChildRelations :: [Table] -> [Column] -> H.Query () [Relation]+allChildRelations :: [Table] -> [Column] -> H.Statement () [Relation] allChildRelations tabs cols =-  H.statement sql HE.unit (decodeRelations tabs cols) True+  H.Statement sql HE.unit (decodeRelations tabs cols) True  where   sql = [q|     SELECT ns1.nspname AS table_schema,@@ -575,9 +581,9 @@     cols  = mapM (findCol rs rt) rcs     colsF = mapM (findCol frs frt) frcs -allPrimaryKeys :: [Table] -> H.Query () [PrimaryKey]+allPrimaryKeys :: [Table] -> H.Statement () [PrimaryKey] allPrimaryKeys tabs =-  H.statement sql HE.unit (decodePks tabs) True+  H.Statement sql HE.unit (decodePks tabs) True  where   sql = [q|     /*@@ -685,68 +691,71 @@ pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n   where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs -allSynonyms :: [Column] -> H.Query Schema [Synonym]-allSynonyms cols =-  H.statement sql (HE.value HE.text) (decodeSynonyms cols) True+allSynonyms :: [Column] -> PgVersion -> H.Statement Schema [Synonym]+allSynonyms cols pgVer =+  H.Statement sql (HE.param HE.text) (decodeSynonyms cols) True   -- query explanation at https://gist.github.com/steve-chavez/7ee0e6590cddafb532e5f00c46275569-  where sql = [q|-    with-    views as (-      select-        n.nspname   as view_schema,-        c.relname   as view_name,-        r.ev_action as view_definition-      from pg_class c-      join pg_namespace n on n.oid = c.relnamespace-      join pg_rewrite r on r.ev_class = c.oid-      where (c.relkind = 'v'::char) and n.nspname = $1-    ),-    removed_subselects as(-      select-        view_schema, view_name,-        regexp_replace(view_definition, ':subselect {.*?:constraintDeps <>} :location', '', 'g') as x-      from views-    ),-    target_lists as(-      select-        view_schema, view_name,-        regexp_split_to_array(x, 'targetList') as x-      from removed_subselects-    ),-    last_target_list_wo_tail as(-      select-        view_schema, view_name,-        (regexp_split_to_array(x[array_upper(x, 1)], ':onConflict'))[1] as x-      from target_lists-    ),-    target_entries as(-      select-        view_schema, view_name,-        unnest(regexp_split_to_array(x, 'TARGETENTRY')) as entry-      from last_target_list_wo_tail-    ),-    results as(+  where+    subselectRegex :: Text+    subselectRegex | pgVer < pgVersion100 = ":subselect {.*?:constraintDeps <>} :location"+                   | otherwise = ":subselect {.*?:stmt_len 0} :location"+    sql = [qc|+      with+      views as (+        select+          n.nspname   as view_schema,+          c.relname   as view_name,+          r.ev_action as view_definition+        from pg_class c+        join pg_namespace n on n.oid = c.relnamespace+        join pg_rewrite r on r.ev_class = c.oid+        where (c.relkind = 'v'::char) and n.nspname = $1+      ),+      removed_subselects as(+        select+          view_schema, view_name,+          regexp_replace(view_definition, '{subselectRegex}', '', 'g') as x+        from views+      ),+      target_lists as(+        select+          view_schema, view_name,+          regexp_split_to_array(x, 'targetList') as x+        from removed_subselects+      ),+      last_target_list_wo_tail as(+        select+          view_schema, view_name,+          (regexp_split_to_array(x[array_upper(x, 1)], ':onConflict'))[1] as x+        from target_lists+      ),+      target_entries as(+        select+          view_schema, view_name,+          unnest(regexp_split_to_array(x, 'TARGETENTRY')) as entry+        from last_target_list_wo_tail+      ),+      results as(+        select+          view_schema, view_name,+          substring(entry from ':resname (.*?) :') as view_colum_name,+          substring(entry from ':resorigtbl (.*?) :') as resorigtbl,+          substring(entry from ':resorigcol (.*?) :') as resorigcol+        from target_entries+      )       select-        view_schema, view_name,-        substring(entry from ':resname (.*?) :') as view_colum_name,-        substring(entry from ':resorigtbl (.*?) :') as resorigtbl,-        substring(entry from ':resorigcol (.*?) :') as resorigcol-      from target_entries-    )-    select-      sch.nspname as table_schema,-      tbl.relname as table_name,-      col.attname as table_column_name,-      res.view_schema,-      res.view_name,-      res.view_colum_name-    from results res-    join pg_class tbl on tbl.oid::text = res.resorigtbl-    join pg_attribute col on col.attrelid = tbl.oid and col.attnum::text = res.resorigcol-    join pg_namespace sch on sch.oid = tbl.relnamespace-    where resorigtbl <> '0'-    order by view_schema, view_name, view_colum_name;-    |]+        sch.nspname as table_schema,+        tbl.relname as table_name,+        col.attname as table_column_name,+        res.view_schema,+        res.view_name,+        res.view_colum_name+      from results res+      join pg_class tbl on tbl.oid::text = res.resorigtbl+      join pg_attribute col on col.attrelid = tbl.oid and col.attnum::text = res.resorigcol+      join pg_namespace sch on sch.oid = tbl.relnamespace+      where resorigtbl <> '0'+      order by view_schema, view_name, view_colum_name; |]  synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe Synonym synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2@@ -756,7 +765,7 @@     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+getPgVersion = H.statement () $ 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+    versionRow = HD.singleRow $ PgVersion <$> HD.column HD.int4 <*> HD.column HD.text

@@ -118,7 +118,10 @@     "details" .= (toS $ fromMaybe "" e :: Text)]   toJSON (P.SessionError e) = JSON.toJSON e -- H.Error -instance JSON.ToJSON H.Error where+instance JSON.ToJSON H.QueryError where+  toJSON (H.QueryError _ _ e) = JSON.toJSON e++instance JSON.ToJSON H.CommandError where   toJSON (H.ResultError (H.ServerError c m d h)) = case toS c of     'P':'T':_ ->       JSON.object [@@ -154,7 +157,7 @@  httpStatus :: Bool -> P.UsageError -> HT.Status httpStatus _ (P.ConnectionError _) = HT.status503-httpStatus authed (P.SessionError (H.ResultError (H.ServerError c m _ _))) =+httpStatus authed (P.SessionError (H.QueryError _ _ (H.ResultError (H.ServerError c m _ _)))) =   case toS c of     '0':'8':_ -> HT.status503 -- pg connection err     '0':'9':_ -> HT.status500 -- triggered action exception@@ -184,5 +187,5 @@     "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+httpStatus _ (P.SessionError (H.QueryError _ _ (H.ResultError _))) = HT.status500+httpStatus _ (P.SessionError (H.QueryError _ _ (H.ClientError _))) = HT.status503

@@ -19,9 +19,9 @@ import           PostgREST.Auth                (JWTAttempt(..)) import           PostgREST.Config              (AppConfig (..), corsPolicy) import           PostgREST.Error               (simpleError)-import           PostgREST.QueryBuilder        (pgFmtLit, unquoted, pgFmtSetLocal)+import           PostgREST.QueryBuilder        (unquoted, pgFmtSetLocal, pgFmtSetLocalSearchPath) -import           Protolude                     hiding (concat, null)+import           Protolude  runWithClaims :: AppConfig -> JWTAttempt ->                  (ApiRequest -> H.Transaction Response) ->@@ -32,7 +32,7 @@     JWTInvalid e -> return $ unauthed $ show e     JWTMissingSecret -> return $ simpleError status500 [] "Server lacks JWT secret"     JWTClaims claims -> do-      H.sql $ toS.mconcat $ setSchemaSql ++ setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql ++ appSettingsSql+      H.sql $ toS . mconcat $ setSearchPathSql : setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql ++ appSettingsSql       mapM_ H.sql customReqCheck       app req       where@@ -40,9 +40,9 @@         cookiesSql = pgFmtSetLocal "request.cookie." <$> iCookies req         claimsSql = pgFmtSetLocal "request.jwt.claim." <$> [(c,unquoted v) | (c,v) <- M.toList claimsWithRole]         appSettingsSql = pgFmtSetLocal mempty <$> configSettings conf-        setRoleSql = maybeToList $-          (\r -> "set local role " <> r <> ";") . toS . pgFmtLit . unquoted <$> M.lookup "role" claimsWithRole-        setSchemaSql = ["set schema " <> pgFmtLit (configSchema conf) <> ";"] :: [Text]+        setRoleSql = maybeToList $ (\x ->+          pgFmtSetLocal mempty ("role", unquoted x)) <$> M.lookup "role" claimsWithRole+        setSearchPathSql = pgFmtSetLocalSearchPath $ configSchema conf : configExtraSearchPath conf         -- role claim defaults to anon if not specified in jwt         claimsWithRole = M.union claims (M.singleton "role" anon)         anon = JSON.String . toS $ configAnonRole conf

@@ -60,7 +60,7 @@       ]     d =       if length n > 1 then-        Just $ append (fromMaybe "" ((`append` "\n\n") <$> colDescription c)) (intercalate "\n" n)+        Just $ append (maybe "" (`append` "\n\n") $ colDescription c) (intercalate "\n" n)       else         colDescription c     s =

@@ -3,6 +3,7 @@ import           Protolude                     hiding (try, intercalate, replace, option) import           Control.Monad                 ((>>)) import           Data.Foldable                 (foldl1)+import           Data.Functor                  (($>)) import qualified Data.HashMap.Strict           as M import           Data.Text                     (intercalate, replace, strip) import           Data.List                     (init, last)@@ -68,17 +69,18 @@                   Node <$> pFieldSelect <*> pure []  pStar :: Parser Text-pStar = toS <$> (string "*" *> pure ("*"::ByteString))+pStar = toS <$> (string "*" $> ("*"::ByteString))  pFieldName :: Parser Text-pFieldName = do-  matches <- (many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) <?> "field name (* or [a..z0..9_])"-  return $ intercalate "-" $ map toS matches+pFieldName =+  pQuotedValue <|>+  intercalate "-" . map toS <$> (many1 (letter <|> digit <|> oneOf "_ ") `sepBy1` dash) <?>+  "field name (* or [a..z0..9_])"   where     isDash :: GenParser Char st ()     isDash = try ( char '-' >> notFollowedBy (char '>') )     dash :: Parser Char-    dash = isDash *> pure '-'+    dash = isDash $> '-'  pJsonPath :: Parser JsonPath pJsonPath = many pJsonOperation@@ -151,10 +153,10 @@ pListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')  pListElement :: Parser Text-pListElement = try pQuotedValue <|> (toS <$> many (noneOf ",)"))+pListElement = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> (toS <$> many (noneOf ",)"))  pQuotedValue :: Parser Text-pQuotedValue = toS <$> (char '"' *> many (noneOf "\"") <* char '"' <* notFollowedBy (noneOf ",)"))+pQuotedValue = toS <$> (char '"' *> many (noneOf "\"") <* char '"')  pDelimiter :: Parser Char pDelimiter = char '.' <?> "delimiter (.)"@@ -184,16 +186,16 @@     pLogicFilter :: Parser Filter     pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal     pNot :: Parser Bool-    pNot = try (string "not" *> pDelimiter *> pure True)+    pNot = try (string "not" *> pDelimiter $> True)            <|> pure False            <?> "negation operator (not)"     pLogicOp :: Parser LogicOperator-    pLogicOp = try (string "and"  *> pure And)-               <|> string "or" *> pure Or+    pLogicOp = try (string "and" $> And)+               <|> string "or" $> Or                <?> "logic operator (and, or)"  pLogicSingleVal :: Parser SingleVal-pLogicSingleVal = try pQuotedValue <|> try pPgArray <|> (toS <$> many (noneOf ",)"))+pLogicSingleVal = try (pQuotedValue <* notFollowedBy (noneOf ",)")) <|> try pPgArray <|> (toS <$> many (noneOf ",)"))   where     pPgArray :: Parser Text     pPgArray =  do@@ -234,9 +236,7 @@     pPath = (,) <$> pJSPKey <*> optionMaybe pJSPIdx  pJSPKey :: Parser Text-pJSPKey = toS <$> (many1 (alphaNum <|> oneOf "_$@") <|> pQuoted) <?> "attribute name [a..z0..9_$@])"-  where-    pQuoted = char '"' *> many (noneOf "\"") <* char '"'+pJSPKey = toS <$> many1 (alphaNum <|> oneOf "_$@") <|> pQuotedValue <?> "attribute name [a..z0..9_$@])"  pJSPIdx :: Parser Int pJSPIdx = char '[' *> (read <$> many1 digit) <* char ']' <?> "array index [0..n]"

@@ -24,15 +24,15 @@   , unquoted   , ResultsWithCount   , pgFmtSetLocal+  , pgFmtSetLocalSearchPath   ) where -import qualified Hasql.Query             as H+import qualified Hasql.Statement         as H import qualified Hasql.Encoders          as HE import qualified Hasql.Decoders          as HD  import qualified Data.Aeson              as JSON -import           PostgREST.Config        (pgVersion96) import           PostgREST.RangeQuery    (rangeLimit, rangeOffset, allRange) import qualified Data.HashMap.Strict     as HM import           Data.Maybe@@ -48,7 +48,7 @@                                          , formatScientific                                          , isInteger                                          )-import           Protolude hiding        (from, intercalate, ord, cast, replace)+import           Protolude hiding        ( intercalate, cast, replace) import           PostgREST.ApiRequest    (PreferRepresentation (..))  {-| The generic query result format used by API responses. The location header@@ -58,10 +58,10 @@ type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString)  standardRow :: HD.Row ResultsWithCount-standardRow = (,,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8-                    <*> HD.value header <*> HD.value HD.bytea+standardRow = (,,,) <$> HD.nullableColumn HD.int8 <*> HD.column HD.int8+                    <*> HD.column header <*> HD.column HD.bytea   where-    header = HD.array $ HD.arrayDimension replicateM $ HD.arrayValue HD.bytea+    header = HD.array $ HD.dimension replicateM $ HD.element HD.bytea  noLocationF :: Text noLocationF = "array[]::text[]"@@ -76,10 +76,10 @@  decodeStandardMay :: HD.Result (Maybe ResultsWithCount) decodeStandardMay =-  HD.maybeRow standardRow+  HD.rowMaybe standardRow  createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->-                       H.Query () ResultsWithCount+                       H.Statement () ResultsWithCount createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =   unicodeStatement sql HE.unit decodeStandard False  where@@ -102,9 +102,9 @@  createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->                         PreferRepresentation -> [Text] ->-                        H.Query ByteString (Maybe ResultsWithCount)+                        H.Statement ByteString (Maybe ResultsWithCount) createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys =-  unicodeStatement sql (HE.value HE.unknown) decodeStandardMay True+  unicodeStatement sql (HE.param HE.unknown) decodeStandardMay True   where   sql = case rep of@@ -139,9 +139,9 @@ type ProcResults = (Maybe Int64, Int64, ByteString, ByteString) callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bool ->             Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> Bool -> PgVersion ->-            H.Query ByteString (Maybe ProcResults)+            H.Statement ByteString (Maybe ProcResults) callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField isObject pgVer =-  unicodeStatement sql (HE.value HE.unknown) decodeProc True+  unicodeStatement sql (HE.param HE.unknown) decodeProc True   where     sql =      if returnsScalar then [qc|@@ -182,9 +182,9 @@       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-                    <*> HD.value HD.bytea <*> HD.value HD.bytea+    decodeProc = HD.rowMaybe procRow+    procRow = (,,,) <$> HD.nullableColumn HD.int8 <*> HD.column HD.int8+                    <*> HD.column HD.bytea <*> HD.column HD.bytea     scalarBodyF      | asBinary = asBinaryF _procName      | otherwise = "(row_to_json(_postgrest_t)->" <> pgFmtLit _procName <> ")::character varying"@@ -230,7 +230,7 @@     ("LIMIT " <> maybe "ALL" show (rangeLimit range) <> " OFFSET " <> show (rangeOffset range)) `emptyOnFalse` (isParent || range == allRange) ]    where-    mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation)+    mainTbl = maybe nodeName (tableName . relTable) maybeRelation     isSelfJoin = maybe False (\r -> relType r /= Root && relTable r == relFTable r) maybeRelation     (qi, tables, joinConds) =       let depthAlias name dpth = if dpth /= 0  then name <> "_" <> show dpth else name in -- Root node doesn't get aliased@@ -381,8 +381,8 @@     n = qiName t     s = qiSchema t -unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Query a b-unicodeStatement = H.statement . T.encodeUtf8+unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Statement a b+unicodeStatement = H.Statement . T.encodeUtf8  emptyOnFalse :: Text -> Bool -> Text emptyOnFalse val cond = if cond then "" else val@@ -414,7 +414,7 @@     In vals -> pgFmtField table fld <> " " <>     let emptyValForIn = "= any('{}') " in -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')"-    case ((&&) (length vals == 1) . T.null) <$> headMay vals of+    case (&&) (length vals == 1) . T.null <$> headMay vals of       Just False -> sqlOperator "in" <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "       Just True  -> emptyValForIn       Nothing    -> emptyValForIn@@ -471,7 +471,11 @@  pgFmtSetLocal :: Text -> (Text, Text) -> SqlFragment pgFmtSetLocal prefix (k, v) =-  "set local " <> pgFmtIdent (prefix <> k) <> " = " <> pgFmtLit v <> ";"+  "SET LOCAL " <> pgFmtIdent (prefix <> k) <> " = " <> pgFmtLit v <> ";"++pgFmtSetLocalSearchPath :: [Text] -> SqlFragment+pgFmtSetLocalSearchPath vals =+  "SET LOCAL search_path = " <> intercalate ", " (pgFmtLit <$> vals) <> ";"  trimNullChars :: Text -> Text trimNullChars = T.takeWhile (/= '\x0')

@@ -32,14 +32,13 @@   case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of     Just parsedRange ->       let [_, mLower, mUpper] = readMaybe . toS <$> parsedRange-          lower         = fromMaybe emptyRange   (rangeGeq <$> mLower)-          upper         = fromMaybe allRange (rangeLeq <$> mUpper) in+          lower         = maybe emptyRange rangeGeq mLower+          upper         = maybe allRange rangeLeq mUpper in       rangeIntersection lower upper     Nothing -> allRange  rangeRequested :: RequestHeaders -> NonnegRange-rangeRequested headers = fromMaybe allRange $-  rangeParse <$> lookup hRange headers+rangeRequested headers = maybe allRange rangeParse $ lookup hRange headers  restrictRange :: Maybe Integer -> NonnegRange -> NonnegRange restrictRange Nothing r = r

@@ -144,6 +144,9 @@   The name 'Relation' here is used with the meaning   "What is the relation between the current node and the parent node".   It has nothing to do with PostgreSQL referring to tables/views as relations.+  The order of the relColumns and relFColumns should be maintained to get+  the join conditions right.+  TODO merge relColumns and relFColumns to a tuple or Data.Bimap -} data Relation = Relation {   relTable    :: Table@@ -317,7 +320,23 @@ data PgVersion = PgVersion {   pgvNum  :: Int32 , pgvName :: Text-} deriving (Eq, Ord, Show)+} deriving (Eq, Show)++instance Ord PgVersion where+  (PgVersion v1 _) `compare` (PgVersion v2 _) = v1 `compare` v2++-- | Tells the minimum PostgreSQL version required by this version of PostgREST+minimumPgVersion :: PgVersion+minimumPgVersion = PgVersion 90400 "9.4"++pgVersion95 :: PgVersion+pgVersion95 = PgVersion 90500 "9.5"++pgVersion96 :: PgVersion+pgVersion96 = PgVersion 90600 "9.6"++pgVersion100 :: PgVersion+pgVersion100 = PgVersion 100000 "10"  sourceCTEName :: SqlFragment sourceCTEName = "pg_source"

@@ -167,7 +167,7 @@      context "used with POST" $       it "includes related data with filters" $-        request methodPost "/child_entities?entities.or=(id.eq.2,id.eq.3)&select=id,entities(id)"+        request methodPost "/child_entities?select=id,entities(id)&entities.or=(id.eq.2,id.eq.3)&entities.order=id"           [("Prefer", "return=representation")]           [json|[{"id":4,"name":"entity 4","parent_id":1},                  {"id":5,"name":"entity 5","parent_id":2},

@@ -8,7 +8,7 @@ import SpecHelper import Network.Wai (Application) -import Protolude hiding (get)+import Protolude -- }}}  spec :: SpecWith Application

@@ -8,7 +8,7 @@ import SpecHelper import Network.Wai (Application) -import Protolude hiding (get)+import Protolude -- }}}  spec :: SpecWith Application

@@ -8,7 +8,7 @@ import Control.Monad.Trans.Control import Control.Concurrent.Async (mapConcurrently) -import Test.Hspec hiding (pendingWith)+import Test.Hspec import Test.Hspec.Wai.Internal import Test.Hspec.Wai import Test.Hspec.Wai.JSON

@@ -11,7 +11,7 @@ import Network.HTTP.Types import Network.Wai (Application) -import Protolude hiding (get)+import Protolude -- }}}  spec :: SpecWith Application@@ -45,7 +45,7 @@             "true"           respHeaders `shouldSatisfy` matchHeader             "Access-Control-Allow-Methods"-            "GET, POST, PATCH, DELETE, OPTIONS, HEAD"+            "GET, POST, PATCH, PUT, DELETE, OPTIONS, HEAD"           respHeaders `shouldSatisfy` matchHeader             "Access-Control-Allow-Headers"             "Authentication, Foo, Bar, Accept, Accept-Language, Content-Language"

@@ -0,0 +1,37 @@+module Feature.ExtraSearchPathSpec where++import Test.Hspec+import Test.Hspec.Wai+import Test.Hspec.Wai.JSON+import Network.HTTP.Types++import SpecHelper+import Network.Wai (Application)++import Protolude++spec :: SpecWith Application+spec = describe "extra search path" $ do++  it "finds the ltree <@ operator on the public schema" $+    request methodGet "/ltree_sample?path=cd.Top.Science.Astronomy" [] ""+      `shouldRespondWith` [json|[+        {"path":"Top.Science.Astronomy"},+        {"path":"Top.Science.Astronomy.Astrophysics"},+        {"path":"Top.Science.Astronomy.Cosmology"}]|]+      { matchHeaders = [matchContentTypeJson] }++  it "finds the ltree nlevel function on the public schema, used through a computed column" $+    request methodGet "/ltree_sample?select=number_of_labels&path=eq.Top.Science" [] ""+      `shouldRespondWith` [json|[{"number_of_labels":2}]|]+      { matchHeaders = [matchContentTypeJson] }++  it "finds the isn = operator on the extensions schema" $+    request methodGet "/isn_sample?id=eq.978-0-393-04002-9&select=name" [] ""+      `shouldRespondWith` [json|[{"name":"Mathematics: From the Birth of Numbers"}]|]+      { matchHeaders = [matchContentTypeJson] }++  it "finds the isn is_valid function on the extensions schema" $+    request methodGet "/rpc/is_valid_isbn?input=978-0-393-04002-9" [] ""+      `shouldRespondWith` [json|true|]+      { matchHeaders = [matchContentTypeJson] }

@@ -8,7 +8,7 @@ import SpecHelper import Network.Wai (Application) -import Protolude hiding (get)+import Protolude -- }}}  spec :: SpecWith Application

@@ -1,6 +1,6 @@ module Feature.PgVersion95Spec where -import Test.Hspec hiding (pendingWith)+import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON 

@@ -1,6 +1,6 @@ module Feature.PgVersion96Spec where -import Test.Hspec hiding (pendingWith)+import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON 

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

@@ -1,6 +1,6 @@ module Feature.QueryLimitedSpec where -import Test.Hspec hiding (pendingWith)+import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Network.HTTP.Types

@@ -1,6 +1,6 @@ module Feature.QuerySpec where -import Test.Hspec hiding (pendingWith)+import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Network.HTTP.Types@@ -395,6 +395,44 @@       it "works when having a capitalized table name and camelCase fk column" $         get "/foos?select=*,bars(*)" `shouldRespondWith` 200 +      it "works when embedding a view with a table that has a long compound pk" $ do+        get "/player_view?select=id,contract(purchase_price)&id=in.(1,3,5,7)" `shouldRespondWith`+          [json|+            [{"id":1,"contract":[{"purchase_price":10}]},+             {"id":3,"contract":[{"purchase_price":30}]},+             {"id":5,"contract":[{"purchase_price":50}]},+             {"id":7,"contract":[]}] |]+          { matchHeaders = [matchContentTypeJson] }+        get "/contract?select=tournament,player_view(first_name)&limit=3" `shouldRespondWith`+          [json|+            [{"tournament":"tournament_1","player_view":{"first_name":"first_name_1"}},+             {"tournament":"tournament_2","player_view":{"first_name":"first_name_2"}},+             {"tournament":"tournament_3","player_view":{"first_name":"first_name_3"}}] |]+          { matchHeaders = [matchContentTypeJson] }++      it "works when embedding a view with a view that referes to a table that has a long compound pk" $ do+        get "/player_view?select=id,contract_view(purchase_price)&id=in.(1,3,5,7)" `shouldRespondWith`+          [json|+            [{"id":1,"contract_view":[{"purchase_price":10}]},+             {"id":3,"contract_view":[{"purchase_price":30}]},+             {"id":5,"contract_view":[{"purchase_price":50}]},+             {"id":7,"contract_view":[]}] |]+          { matchHeaders = [matchContentTypeJson] }+        get "/contract_view?select=tournament,player_view(first_name)&limit=3" `shouldRespondWith`+          [json|+            [{"tournament":"tournament_1","player_view":{"first_name":"first_name_1"}},+             {"tournament":"tournament_2","player_view":{"first_name":"first_name_2"}},+             {"tournament":"tournament_3","player_view":{"first_name":"first_name_3"}}] |]+          { matchHeaders = [matchContentTypeJson] }++      it "can embed a view that has group by" $+        get "/projects_count_grouped_by?select=number_of_projects,client(name)&order=number_of_projects" `shouldRespondWith`+          [json|+            [{"number_of_projects":1,"client":null},+             {"number_of_projects":2,"client":{"name":"Microsoft"}},+             {"number_of_projects":2,"client":{"name":"Apple"}}] |]+          { matchHeaders = [matchContentTypeJson] }+     describe "path fixed" $ do       it "works when requesting children 2 levels" $         get "/clients?id=eq.1&select=id,projects:projects.client_id(id,tasks(id))" `shouldRespondWith`@@ -781,6 +819,20 @@         [json| [{"escapeId":{"so6meIdColumn":1}},{"escapeId":{"so6meIdColumn":3}},{"escapeId":{"so6meIdColumn":5}}] |]         { matchHeaders = [matchContentTypeJson] } +    it "will select and filter a column that has spaces" $+      get "/Server%20Today?select=Just%20A%20Server%20Model&Just%20A%20Server%20Model=like.*91*" `shouldRespondWith`+        [json|[+          {"Just A Server Model":" IBM,9113-550 (P5-550)"},+          {"Just A Server Model":" IBM,9113-550 (P5-550)"},+          {"Just A Server Model":" IBM,9131-52A (P5-52A)"},+          {"Just A Server Model":" IBM,9133-55A (P5-55A)"}]|]+        { matchHeaders = [matchContentTypeJson] }++    it "will select and filter a quoted column that has PostgREST reserved characters" $+      get "/pgrst_reserved_chars?select=%22:arr-%3Eow::cast%22,%22(inside,parens)%22,%22a.dotted.column%22,%22%20%20col%20%20w%20%20space%20%20%22&%22*id*%22=eq.1" `shouldRespondWith`+        [json|[{":arr->ow::cast":" arrow-1 ","(inside,parens)":" parens-1 ","a.dotted.column":" dotted-1 ","  col  w  space  ":" space-1"}]|]+        { matchHeaders = [matchContentTypeJson] }+   describe "binary output" $ do     context "on GET" $ do       it "can query if a single column is selected" $@@ -963,3 +1015,6 @@       get "/projects_dump?select=id,name&order=id.desc&limit=3" `shouldRespondWith`         [json| [{"id":5,"name":"Orphan"}, {"id":4,"name":"OSX"}, {"id":3,"name":"IOS"}] |]         { matchHeaders = [matchContentTypeJson] }++  it "cannot use ltree(in public schema) extension operators if no extra search path added" $+    get "/ltree_sample?path=cd.Top.Science.Astronomy" `shouldRespondWith` 400

@@ -1,6 +1,6 @@ module Feature.RpcSpec where -import Test.Hspec hiding (pendingWith)+import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Network.HTTP.Types@@ -370,4 +370,9 @@           { 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] }++    it "should work with an argument of custom type in public schema" $+        get "/rpc/test_arg?my_arg=something" `shouldRespondWith`+          [json|"foobar"|]           { matchHeaders = [matchContentTypeJson] }

@@ -1,6 +1,6 @@ module Feature.StructureSpec where -import Test.Hspec hiding (pendingWith)+import Test.Hspec import Test.Hspec.Wai import Network.HTTP.Types 

@@ -4,11 +4,11 @@ import SpecHelper  import qualified Hasql.Pool as P+import qualified Hasql.Transaction.Sessions as HT  import PostgREST.App (postgrest)-import PostgREST.Config (pgVersion95, pgVersion96) import PostgREST.DbStructure (getDbStructure, getPgVersion)-import PostgREST.Types (DbStructure(..))+import PostgREST.Types (DbStructure(..), pgVersion95, pgVersion96) import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction) import Data.Function (id) import Data.IORef@@ -21,6 +21,7 @@ import qualified Feature.ConcurrentSpec import qualified Feature.CorsSpec import qualified Feature.DeleteSpec+import qualified Feature.ExtraSearchPathSpec import qualified Feature.InsertSpec import qualified Feature.JsonOperatorSpec import qualified Feature.NoJwtSpec@@ -47,7 +48,9 @@    pool <- P.acquire (3, 10, toS testDbConn) -  result <- P.use pool $ getDbStructure "test" =<< getPgVersion+  result <- P.use pool $ do+    ver <- getPgVersion+    HT.transaction HT.ReadCommitted HT.Read $ getDbStructure "test" ver    dbStructure <- pure $ either (panic.show) id result @@ -55,15 +58,17 @@    refDbStructure <- newIORef $ Just dbStructure -  let withApp              = return $ postgrest (testCfg testDbConn)            refDbStructure pool getTime $ pure ()-      ltdApp               = return $ postgrest (testLtdRowsCfg testDbConn)     refDbStructure pool getTime $ pure ()-      unicodeApp           = return $ postgrest (testUnicodeCfg testDbConn)     refDbStructure pool getTime $ pure ()-      proxyApp             = return $ postgrest (testProxyCfg testDbConn)       refDbStructure pool getTime $ pure ()-      noJwtApp             = return $ postgrest (testCfgNoJWT testDbConn)       refDbStructure pool getTime $ pure ()-      binaryJwtApp         = return $ postgrest (testCfgBinaryJWT testDbConn)   refDbStructure pool getTime $ pure ()-      audJwtApp            = return $ postgrest (testCfgAudienceJWT testDbConn) refDbStructure pool getTime $ pure ()-      asymJwkApp           = return $ postgrest (testCfgAsymJWK testDbConn)     refDbStructure pool getTime $ pure ()-      nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn)   refDbStructure pool getTime $ pure ()+  let withApp              = return $ postgrest (testCfg testDbConn)                  refDbStructure pool getTime $ pure ()+      ltdApp               = return $ postgrest (testLtdRowsCfg testDbConn)           refDbStructure pool getTime $ pure ()+      unicodeApp           = return $ postgrest (testUnicodeCfg testDbConn)           refDbStructure pool getTime $ pure ()+      proxyApp             = return $ postgrest (testProxyCfg testDbConn)             refDbStructure pool getTime $ pure ()+      noJwtApp             = return $ postgrest (testCfgNoJWT testDbConn)             refDbStructure pool getTime $ pure ()+      binaryJwtApp         = return $ postgrest (testCfgBinaryJWT testDbConn)         refDbStructure pool getTime $ pure ()+      audJwtApp            = return $ postgrest (testCfgAudienceJWT testDbConn)       refDbStructure pool getTime $ pure ()+      asymJwkApp           = return $ postgrest (testCfgAsymJWK testDbConn)           refDbStructure pool getTime $ pure ()+      asymJwkSetApp        = return $ postgrest (testCfgAsymJWKSet testDbConn)        refDbStructure pool getTime $ pure ()+      nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn) refDbStructure pool getTime $ pure ()+      extraSearchPathApp   = return $ postgrest (testCfgExtraSearchPath testDbConn)   refDbStructure pool getTime $ pure ()    let reset :: IO ()       reset = resetDb testDbConn@@ -87,7 +92,6 @@         , ("Feature.SingularSpec"           , Feature.SingularSpec.spec)         , ("Feature.StructureSpec"          , Feature.StructureSpec.spec)         , ("Feature.AndOrParamsSpec"        , Feature.AndOrParamsSpec.spec)-        , ("Feature.NonexistentSchemaSpec"  , Feature.NonexistentSchemaSpec.spec)         ] ++ extraSpecs    hspec $ do@@ -121,6 +125,14 @@     beforeAll_ reset . before asymJwkApp $       describe "Feature.AsymmetricJwtSpec" Feature.AsymmetricJwtSpec.spec +    -- this test runs with asymmetric JWKSet+    beforeAll_ reset . before asymJwkSetApp $+      describe "Feature.AsymmetricJwtSpec" Feature.AsymmetricJwtSpec.spec+     -- this test runs with a nonexistent db-schema     beforeAll_ reset . before nonexistentSchemaApp $       describe "Feature.NonexistentSchemaSpec" Feature.NonexistentSchemaSpec.spec++    -- this test runs with an extra search path+    beforeAll_ reset . before extraSearchPathApp $+      describe "Feature.ExtraSearchPathSpec" Feature.ExtraSearchPathSpec.spec

@@ -19,7 +19,7 @@ import PostgREST.Config (AppConfig(..)) import PostgREST.Types  (JSPathExp(..)) -import Test.Hspec hiding (pendingWith)+import Test.Hspec import Test.Hspec.Wai  import Network.HTTP.Types@@ -61,9 +61,8 @@        D4.fetchFilesystemAndValidate schemaContext ((fromJust . decode) respBody) `shouldReturn` Right ()  getEnvVarWithDefault :: Text -> Text -> IO Text-getEnvVarWithDefault var def = do-  varValue <- getEnv (toS var) `E.catchIOError` const (return $ toS def)-  return $ toS varValue+getEnvVarWithDefault var def = toS <$>+  getEnv (toS var) `E.catchIOError` const (return $ toS def)  _baseCfg :: AppConfig _baseCfg =  -- Connection Settings@@ -79,6 +78,8 @@             ]             -- Default role claim key             (Right [JSPKey "role"])+            -- Empty db-extra-search-path+            []  testCfg :: Text -> AppConfig testCfg testDbConn = _baseCfg { configDatabase = testDbConn }@@ -114,9 +115,18 @@       [str|{"alg":"RS256","e":"AQAB","key_ops":["verify"],"kty":"RSA","n":"0etQ2Tg187jb04MWfpuogYGV75IFrQQBxQaGH75eq_FpbkyoLcEpRUEWSbECP2eeFya2yZ9vIO5ScD-lPmovePk4Aa4SzZ8jdjhmAbNykleRPCxMg0481kz6PQhnHRUv3nF5WP479CnObJKqTVdEagVL66oxnX9VhZG9IZA7k0Th5PfKQwrKGyUeTGczpOjaPqbxlunP73j9AfnAt4XCS8epa-n3WGz1j-wfpr_ys57Aq-zBCfqP67UYzNpeI1AoXsJhD9xSDOzvJgFRvc3vm2wjAW4LEMwi48rCplamOpZToIHEPIaPzpveYQwDnB1HFTR1ove9bpKJsHmi-e2uzQ","use":"sig"}|]   } +testCfgAsymJWKSet :: Text -> AppConfig+testCfgAsymJWKSet testDbConn = (testCfg testDbConn) {+    configJwtSecret = Just $ encodeUtf8+      [str|{"keys": [{"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" } +testCfgExtraSearchPath :: Text -> AppConfig+testCfgExtraSearchPath testDbConn = (testCfg testDbConn) { configExtraSearchPath = ["public", "extensions"] }+ setupDb :: Text -> IO () setupDb dbConn = do   loadFixture dbConn "database"@@ -166,5 +176,5 @@     S.null (S.difference keys validKeys)  where   obj = decode s :: Maybe (M.Map Text Value)-  keys = fromMaybe S.empty (M.keysSet <$> obj)+  keys = maybe S.empty M.keysSet obj   validKeys = S.fromList ["message", "details", "hint", "code"]