postgrest 6.0.0 → 6.0.1
raw patch · 18 files changed
+658/−443 lines, 18 filesdep ~jose
Dependency ranges changed: jose
Files
- CHANGELOG.md +14/−1
- postgrest.cabal +8/−2
- src/PostgREST/App.hs +16/−11
- src/PostgREST/Config.hs +11/−0
- src/PostgREST/QueryBuilder.hs +13/−371
- src/PostgREST/QueryBuilder/Private.hs +237/−0
- src/PostgREST/QueryBuilder/Procedure.hs +85/−0
- src/PostgREST/QueryBuilder/ReadStatement.hs +32/−0
- src/PostgREST/QueryBuilder/WriteStatement.hs +53/−0
- src/PostgREST/Types.hs +12/−8
- test/Feature/AndOrParamsSpec.hs +45/−4
- test/Feature/AuthSpec.hs +2/−2
- test/Feature/HtmlRawOutputSpec.hs +30/−0
- test/Feature/QuerySpec.hs +40/−3
- test/Feature/RawOutputTypesSpec.hs +33/−0
- test/Feature/RpcSpec.hs +12/−39
- test/Main.hs +10/−2
- test/SpecHelper.hs +5/−0
CHANGELOG.md view
@@ -9,11 +9,23 @@ ### Fixed +## [6.0.1] - 2019-07-30++### Added++- #1349, Add user defined raw output media types via `raw-media-types` config option - @Dansvidania+- #1243, Add websearch_to_tsquery support - @herulume++### Fixed++- #1336, Error when testing on Chrome/Firefox: text/html requested but a single column was not selected - @Dansvidania+- #1334, Unable to compile v6.0.0 on windows - @steve-chavez+ ## [6.0.0] - 2019-06-21 ### Added -- #1186, Add support for user defined unix socket via `server-unix-socket` config option+- #1186, Add support for user defined unix socket via `server-unix-socket` config option - @Dansvidania - #690, Add `?columns` query parameter for faster bulk inserts, also ignores unspecified json keys in a payload - @steve-chavez - #1239, Add support for resource embedding on materialized views - @vitorbaptista - #1264, Add support for bulk RPC call - @steve-chavez@@ -21,6 +33,7 @@ - #1285, Abort on wrong database password - @qu4tro - #790, Allow override of OpenAPI spec through `root-spec` config option - @steve-chavez - #1308, Accept `text/plain` and `text/html` for raw output - @steve-chavez+ ### Fixed
postgrest.cabal view
@@ -1,5 +1,5 @@ name: postgrest-version: 6.0.0+version: 6.0.1 synopsis: REST API for any Postgres database description: Reads the schema of a PostgreSQL database and creates RESTful routes for the tables and views, supporting all HTTP verbs that security@@ -39,6 +39,10 @@ PostgREST.RangeQuery PostgREST.Types other-modules: Paths_postgrest+ PostgREST.QueryBuilder.Private+ PostgREST.QueryBuilder.Procedure+ PostgREST.QueryBuilder.ReadStatement+ PostgREST.QueryBuilder.WriteStatement hs-source-dirs: src build-depends: base >= 4.9 && < 4.13 , HTTP >= 4000.3.7 && < 4000.4@@ -63,7 +67,7 @@ , http-types >= 0.12.2 && < 0.13 , insert-ordered-containers >= 0.1 && < 0.3 , interpolatedstring-perl6 >= 1 && < 1.1- , jose >= 0.7 && < 0.8+ , jose >= 0.8.1 && < 0.9 , lens >= 4.14 && < 4.18 , lens-aeson >= 1.0.1 && < 1.1 , network-uri >= 2.6.1 && < 2.7@@ -141,6 +145,8 @@ Feature.StructureSpec Feature.UnicodeSpec Feature.UpsertSpec+ Feature.RawOutputTypesSpec+ Feature.HtmlRawOutputSpec SpecHelper TestTypes hs-source-dirs: test
src/PostgREST/App.hs view
@@ -8,6 +8,7 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.HashMap.Strict as M+import qualified Data.List as L (union) import qualified Data.Set as S import qualified Hasql.Pool as P import qualified Hasql.Transaction as H@@ -56,7 +57,6 @@ postgrest conf refDbStructure pool getTime worker = let middle = (if configQuiet conf then id else logStdout) . defaultMiddle jwtSecret = parseSecret <$> configJwtSecret conf in- middle $ \ req respond -> do time <- getTime body <- strictRequestBody req@@ -103,14 +103,14 @@ app :: DbStructure -> Maybe ProcDescription -> S.Set FieldName -> AppConfig -> ApiRequest -> H.Transaction Response app dbStructure proc cols conf apiRequest =- case responseContentTypeOrError (iAccepts apiRequest) (iAction apiRequest) (iTarget apiRequest) of+ case responseContentTypeOrError (iAccepts apiRequest) rawContentTypes (iAction apiRequest) (iTarget apiRequest) of Left errorResponse -> return errorResponse Right contentType -> case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of (ActionRead, TargetIdent qi, Nothing) -> let partsField = (,) <$> readSqlParts- <*> (binaryField contentType =<< fldNames) in+ <*> (binaryField contentType rawContentTypes =<< fldNames) in case partsField of Left errorResponse -> return errorResponse Right ((q, cq), bField) -> do@@ -265,7 +265,7 @@ _ -> False rpcBinaryField = if returnsScalar then Right Nothing- else binaryField contentType =<< fldNames+ else binaryField contentType rawContentTypes =<< fldNames parts = (,) <$> readSqlParts <*> rpcBinaryField in case parts of Left errorResponse -> return errorResponse@@ -329,17 +329,22 @@ mutateSqlParts s t = (,) <$> selectQuery <*> (requestToQuery schema False . DbMutate <$> mutationDbRequest s t)+ rawContentTypes =+ (decodeContentType <$> configRawMediaTypes conf) `L.union`+ [ CTOctetStream, CTTextPlain ] -responseContentTypeOrError :: [ContentType] -> Action -> Target -> Either Response ContentType-responseContentTypeOrError accepts action target = serves contentTypesForRequest accepts+responseContentTypeOrError :: [ContentType] -> [ContentType] -> Action -> Target -> Either Response ContentType+responseContentTypeOrError accepts rawContentTypes action target = serves contentTypesForRequest accepts where contentTypesForRequest = case action of- ActionRead -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] ++ rawContentTypes+ ActionRead -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]+ ++ rawContentTypes ActionCreate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] ActionUpdate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] ActionDelete -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]- ActionInvoke _ -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] ++ rawContentTypes ++- [CTOpenAPI | tpIsRootSpec target]+ ActionInvoke _ -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]+ ++ rawContentTypes+ ++ [CTOpenAPI | tpIsRootSpec target] ActionInspect -> [CTOpenAPI, CTApplicationJSON] ActionInfo -> [CTTextCSV] ActionSingleUpsert -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]@@ -352,8 +357,8 @@ | If raw(binary) output is requested, check that ContentType is one of the admitted rawContentTypes and that | `?select=...` contains only one field other than `*` -}-binaryField :: ContentType -> [FieldName] -> Either Response (Maybe FieldName)-binaryField ct fldNames+binaryField :: ContentType -> [ContentType]-> [FieldName] -> Either Response (Maybe FieldName)+binaryField ct rawContentTypes fldNames | ct `elem` rawContentTypes = let fieldName = headMay fldNames in if length fldNames == 1 && fieldName /= Just "*"
src/PostgREST/Config.hs view
@@ -88,6 +88,7 @@ , configExtraSearchPath :: [Text] , configRootSpec :: Maybe QualifiedIdentifier+ , configRawMediaTypes :: [B.ByteString] } configPoolTimeout' :: (Fractional a) => AppConfig -> a@@ -168,6 +169,7 @@ <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> optValue "role-claim-key") <*> (maybe ["public"] splitExtraSearchPath <$> optValue "db-extra-search-path") <*> ((\x y -> QualifiedIdentifier x <$> y) <$> dbSchema <*> optString "root-spec")+ <*> (fmap encodeUtf8 <$> optionalListOfText "raw-media-types") parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI) parseJwtAudience k =@@ -178,6 +180,12 @@ (Just "") -> pure Nothing aud' -> pure aud' + optionalListOfText :: C.Key -> C.Parser C.Config [Text]+ optionalListOfText k =+ C.optional k (C.list C.string) >>= \case+ Nothing -> pure []+ Just types -> pure types+ reqString :: C.Key -> C.Parser C.Config Text reqString k = C.required k C.string @@ -273,6 +281,9 @@ |## stored proc that overrides the root "/" spec |## it must be inside the db-schema |# root-spec = "stored_proc_name"+ |+ |## content types to produce raw output+ |# raw-media-types=["image/png","image/jpg"] |] pathParser :: Parser FilePath
src/PostgREST/QueryBuilder.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module : PostgREST.QueryBuilder@@ -17,8 +16,6 @@ callProc , createReadStatement , createWriteStatement- , pgFmtIdent- , pgFmtLit , requestToQuery , requestToCountQuery , unquoted@@ -27,215 +24,24 @@ , pgFmtSetLocalSearchPath ) where -import qualified Data.Aeson as JSON-import qualified Data.ByteString.Char8 as BS-import qualified Data.HashMap.Strict as HM-import qualified Data.Set as S-import qualified Data.Text as T (map, null, takeWhile)-import qualified Data.Text.Encoding as T-import qualified Hasql.Decoders as HD-import qualified Hasql.Encoders as HE-import qualified Hasql.Statement as H+import qualified Data.Aeson as JSON+import qualified Data.Set as S -import Data.Scientific (FPFormat (..), formatScientific,- isInteger)-import Data.Text (intercalate, isInfixOf, replace,- toLower, unwords)-import Data.Tree (Tree (..))-import Text.InterpolatedString.Perl6 (qc)+import Data.Scientific (FPFormat (..), formatScientific, isInteger)+import Data.Text (intercalate, unwords)+import Data.Tree (Tree (..)) import Data.Maybe -import PostgREST.ApiRequest (PreferRepresentation (..))-import PostgREST.RangeQuery (allRange, rangeLimit, rangeOffset)+import PostgREST.QueryBuilder.Private+import PostgREST.QueryBuilder.Procedure+import PostgREST.QueryBuilder.ReadStatement+import PostgREST.QueryBuilder.WriteStatement+import PostgREST.RangeQuery (allRange, rangeLimit,+ rangeOffset) import PostgREST.Types-import Protolude hiding (cast, intercalate, replace)--column :: HD.Value a -> HD.Row a-column = HD.column . HD.nonNullable--nullableColumn :: HD.Value a -> HD.Row (Maybe a)-nullableColumn = HD.column . HD.nullable--element :: HD.Value a -> HD.Array a-element = HD.element . HD.nonNullable--param :: HE.Value a -> HE.Params a-param = HE.param . HE.nonNullable--{-| The generic query result format used by API responses. The location header- is represented as a list of strings containing variable bindings like- @"k1=eq.42"@, or the empty list if there is no location header.--}-type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString)--standardRow :: HD.Row ResultsWithCount-standardRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8- <*> column header <*> column HD.bytea- where- header = HD.array $ HD.dimension replicateM $ element HD.bytea--noLocationF :: Text-noLocationF = "array[]::text[]"--{-| Read and Write api requests use a similar response format which includes- various record counts and possible location header. This is the decoder- for that common type of query.--}-decodeStandard :: HD.Result ResultsWithCount-decodeStandard =- HD.singleRow standardRow--decodeStandardMay :: HD.Result (Maybe ResultsWithCount)-decodeStandardMay =- HD.rowMaybe standardRow--createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->- H.Statement () ResultsWithCount-createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =- unicodeStatement sql HE.noParams decodeStandard False- where- sql = [qc|- WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols}- FROM ( SELECT * FROM {sourceCTEName}) _postgrest_t |]- countResultF = if countTotal then "("<>countQuery<>")" else "null"- cols = intercalate ", " [- countResultF <> " AS total_result_set",- "pg_catalog.count(_postgrest_t) AS page_total",- noLocationF <> " AS header",- bodyF <> " AS body"- ]- bodyF- | asCsv = asCsvF- | isSingle = asJsonSingleF- | isJust binaryField = asBinaryF $ fromJust binaryField- | otherwise = asJsonF---createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->- PreferRepresentation -> [Text] ->- H.Statement ByteString (Maybe ResultsWithCount)-createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys =- unicodeStatement sql (param HE.unknown) decodeStandardMay True-- where- sql = case rep of- None -> [qc|- WITH {sourceCTEName} AS ({mutateQuery})- SELECT '', 0, {noLocationF}, '' |]- HeadersOnly -> [qc|- WITH {sourceCTEName} AS ({mutateQuery})- SELECT {cols}- FROM (SELECT 1 FROM {sourceCTEName}) _postgrest_t |]- Full -> [qc|- WITH {sourceCTEName} AS ({mutateQuery})- SELECT {cols}- FROM ({selectQuery}) _postgrest_t |]-- cols = intercalate ", " [- "'' AS total_result_set", -- when updateing it does not make sense- "pg_catalog.count(_postgrest_t) AS page_total",- if isInsert- then unwords [- "CASE",- "WHEN pg_catalog.count(_postgrest_t) = 1 THEN",- "coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",- "ELSE " <> noLocationF,- "END AS header"]- else noLocationF <> "AS header",- if rep == Full- then bodyF <> " AS body"- else "''"- ]-- bodyF- | asCsv = asCsvF- | wantSingle = asJsonSingleF- | otherwise = asJsonF--type ProcResults = (Maybe Int64, Int64, ByteString, ByteString)-callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bool ->- Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->- H.Statement ByteString (Maybe ProcResults)-callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField pgVer =- unicodeStatement sql (param HE.unknown) decodeProc True- where- sql =[qc|- WITH- {argsRecord},- {sourceCTEName} AS (- {sourceBody}- )- SELECT- {countResultF} AS total_result_set,- pg_catalog.count(_postgrest_t) AS page_total,- {bodyF} AS body,- {responseHeaders} AS response_headers- FROM ({selectQuery}) _postgrest_t;|]-- (argsRecord, args)- | paramsAsSingleObject = ("_args_record AS (SELECT NULL)", "$1::json")- | null pgArgs = (ignoredBody, "")- | otherwise = (- unwords [- normalizedBody <> ",",- "_args_record AS (",- "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <>- intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " " <> pgaType a) <$> pgArgs) <> ")",- ")"]- , intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " := _args_record." <> pgFmtIdent (pgaName a)) <$> pgArgs))-- sourceBody :: SqlFragment- sourceBody- | paramsAsSingleObject || null pgArgs =- if returnsScalar- then [qc| SELECT {fromQi qi}({args}) |]- else [qc| SELECT * FROM {fromQi qi}({args}) |]- | otherwise =- if returnsScalar- then [qc| SELECT {fromQi qi}({args}) FROM _args_record |]- else [qc| SELECT _.*- FROM _args_record,- LATERAL ( SELECT * FROM {fromQi qi}({args}) ) _ |]-- bodyF- | returnsScalar = scalarBodyF- | isSingle = asJsonSingleF- | asCsv = asCsvF- | isJust binaryField = asBinaryF $ fromJust binaryField- | otherwise = asJsonF-- scalarBodyF- | asBinary = asBinaryF _procName- | otherwise = unwords [- "CASE",- "WHEN pg_catalog.count(_postgrest_t) = 1",- "THEN (json_agg(_postgrest_t." <> pgFmtIdent _procName <> ")->0)::character varying",- "ELSE (json_agg(_postgrest_t." <> pgFmtIdent _procName <> "))::character varying",- "END"]-- countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text- _procName = qiName qi- responseHeaders =- if pgVer >= pgVersion96- then "coalesce(nullif(current_setting('response.headers', true), ''), '[]')" :: Text -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15- else "'[]'" :: Text-- decodeProc = HD.rowMaybe procRow- procRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8- <*> column HD.bytea <*> column HD.bytea--pgFmtIdent :: SqlFragment -> SqlFragment-pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\""--pgFmtLit :: SqlFragment -> SqlFragment-pgFmtLit x =- let trimmed = trimNullChars x- escaped = "'" <> replace "'" "''" trimmed <> "'"- slashed = replace "\\" "\\\\" escaped in- if "\\" `isInfixOf` escaped- then "E" <> slashed- else slashed+import Protolude hiding (cast,+ intercalate, replace) requestToCountQuery :: Schema -> DbRequest -> SqlQuery requestToCountQuery _ (DbMutate _) = witness@@ -339,173 +145,9 @@ where qi = QualifiedIdentifier schema mainTbl --- Due to the use of the `unknown` encoder we need to cast '$1' when the value is not used in the main query--- otherwise the query will err with a `could not determine data type of parameter $1`.--- This happens because `unknown` relies on the context to determine the value type.--- The error also happens on raw libpq used with C.-ignoredBody :: SqlFragment-ignoredBody = "ignored_body AS (SELECT $1::text) "---- |--- These CTEs convert a json object into a json array, this way we can use json_populate_recordset for all json payloads--- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays--- We do this in SQL to avoid processing the JSON in application code-normalizedBody :: SqlFragment-normalizedBody =- unwords [- "pgrst_payload AS (SELECT $1::json AS json_data),",- "pgrst_body AS (",- "SELECT",- "CASE WHEN json_typeof(json_data) = 'array'",- "THEN json_data",- "ELSE json_build_array(json_data)",- "END AS val",- "FROM pgrst_payload)"]--selectBody :: SqlFragment-selectBody = "(SELECT val FROM pgrst_body)"--removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier-removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl- unquoted :: JSON.Value -> Text unquoted (JSON.String t) = t unquoted (JSON.Number n) = toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n unquoted (JSON.Bool b) = show b unquoted v = toS $ JSON.encode v---- private functions-asCsvF :: SqlFragment-asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF- where- asCsvHeaderF =- "(SELECT coalesce(string_agg(a.k, ','), '')" <>- " FROM (" <>- " SELECT json_object_keys(r)::TEXT as k" <>- " FROM ( " <>- " SELECT row_to_json(hh) as r from " <> sourceCTEName <> " as hh limit 1" <>- " ) s" <>- " ) a" <>- ")"- asCsvBodyF = "coalesce(string_agg(substring(_postgrest_t::text, 2, length(_postgrest_t::text) - 2), '\n'), '')"--asJsonF :: SqlFragment-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 "--asBinaryF :: FieldName -> SqlFragment-asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"--locationF :: [Text] -> SqlFragment-locationF pKeys = [qc|(- WITH data AS (SELECT row_to_json(_) AS row FROM {sourceCTEName} AS _ LIMIT 1)- SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))- FROM data CROSS JOIN json_each_text(data.row) AS json_data- {("WHERE json_data.key IN ('" <> intercalate "','" pKeys <> "')") `emptyOnFalse` null pKeys}-)|]--fromQi :: QualifiedIdentifier -> SqlFragment-fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n- where- n = qiName t- s = qiSchema t--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--pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment-pgFmtColumn table "*" = fromQi table <> ".*"-pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c--pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment-pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp--pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment-pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _) = pgFmtField table f <> pgFmtAs fName jp alias-pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs fName jp alias--pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SqlFragment-pgFmtOrderTerm qi ot = unwords [- toS . pgFmtField qi $ otTerm ot,- maybe "" show $ otDirection ot,- maybe "" show $ otNullOrder ot]--pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment-pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of- Op op val -> pgFmtFieldOp op <> " " <> case op of- "like" -> unknownLiteral (T.map star val)- "ilike" -> unknownLiteral (T.map star val)- "is" -> whiteList val- _ -> unknownLiteral val-- 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- Just False -> sqlOperator "in" <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "- Just True -> emptyValForIn- Nothing -> emptyValForIn-- Fts op lang val ->- pgFmtFieldOp op- <> "("- <> maybe "" ((<> ", ") . pgFmtLit) lang- <> unknownLiteral val- <> ") "- where- pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op- sqlOperator o = HM.lookupDefault "=" o operators- 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"])--pgFmtJoinCondition :: JoinCondition -> SqlFragment-pgFmtJoinCondition (JoinCondition (qi, col1) (QualifiedIdentifier schema fTable, col2)) =- pgFmtColumn qi col1 <> " = " <>- pgFmtColumn (removeSourceCTESchema schema fTable) col2--pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment-pgFmtLogicTree qi (Expr hasNot op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")"- where notOp = if hasNot then "NOT" else ""-pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt--pgFmtJsonPath :: JsonPath -> SqlFragment-pgFmtJsonPath = \case- [] -> ""- (JArrow x:xs) -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs- (J2Arrow x:xs) -> "->>" <> pgFmtJsonOperand x <> pgFmtJsonPath xs- where- pgFmtJsonOperand (JKey k) = pgFmtLit k- pgFmtJsonOperand (JIdx i) = pgFmtLit i <> "::int"--pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SqlFragment-pgFmtAs _ [] Nothing = ""-pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of- Just (JKey key) -> " AS " <> pgFmtIdent key- Just (JIdx _) -> " AS " <> pgFmtIdent (fromMaybe fName lastKey)- -- We get the lastKey because on:- -- `select=data->1->mycol->>2`, we need to show the result as [ {"mycol": ..}, {"mycol": ..} ]- -- `select=data->3`, we need to show the result as [ {"data": ..}, {"data": ..} ]- where lastKey = jVal <$> find (\case JKey{} -> True; _ -> False) (jOp <$> reverse jp)- Nothing -> ""-pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias--pgFmtSetLocal :: Text -> (Text, Text) -> SqlFragment-pgFmtSetLocal prefix (k, 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')
+ src/PostgREST/QueryBuilder/Private.hs view
@@ -0,0 +1,237 @@+{-# LANGUAGE LambdaCase #-}+{-|+Module : PostgREST.QueryBuilder.Private+Description : Helper functions for PostgREST.QueryBuilder.+-}+module PostgREST.QueryBuilder.Private where++import qualified Data.ByteString.Char8 as BS+import qualified Data.HashMap.Strict as HM+import Data.Maybe+import Data.Text (intercalate,+ isInfixOf, replace,+ toLower, unwords)+import qualified Data.Text as T (map, null,+ takeWhile)+import qualified Data.Text.Encoding as T+import qualified Hasql.Decoders as HD+import qualified Hasql.Encoders as HE+import qualified Hasql.Statement as H+import PostgREST.Types+import Protolude hiding (cast,+ intercalate, replace)+import Text.InterpolatedString.Perl6 (qc)++column :: HD.Value a -> HD.Row a+column = HD.column . HD.nonNullable++nullableColumn :: HD.Value a -> HD.Row (Maybe a)+nullableColumn = HD.column . HD.nullable++element :: HD.Value a -> HD.Array a+element = HD.element . HD.nonNullable++param :: HE.Value a -> HE.Params a+param = HE.param . HE.nonNullable++{-| The generic query result format used by API responses. The location header+ is represented as a list of strings containing variable bindings like+ @"k1=eq.42"@, or the empty list if there is no location header.+-}+type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString)++standardRow :: HD.Row ResultsWithCount+standardRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8+ <*> column header <*> column HD.bytea+ where+ header = HD.array $ HD.dimension replicateM $ element HD.bytea++noLocationF :: Text+noLocationF = "array[]::text[]"++{-| Read and Write api requests use a similar response format which includes+ various record counts and possible location header. This is the decoder+ for that common type of query.+-}+decodeStandard :: HD.Result ResultsWithCount+decodeStandard =+ HD.singleRow standardRow++decodeStandardMay :: HD.Result (Maybe ResultsWithCount)+decodeStandardMay =+ HD.rowMaybe standardRow++removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier+removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl++-- Due to the use of the `unknown` encoder we need to cast '$1' when the value is not used in the main query+-- otherwise the query will err with a `could not determine data type of parameter $1`.+-- This happens because `unknown` relies on the context to determine the value type.+-- The error also happens on raw libpq used with C.+ignoredBody :: SqlFragment+ignoredBody = "ignored_body AS (SELECT $1::text) "++-- |+-- These CTEs convert a json object into a json array, this way we can use json_populate_recordset for all json payloads+-- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays+-- We do this in SQL to avoid processing the JSON in application code+normalizedBody :: SqlFragment+normalizedBody =+ unwords [+ "pgrst_payload AS (SELECT $1::json AS json_data),",+ "pgrst_body AS (",+ "SELECT",+ "CASE WHEN json_typeof(json_data) = 'array'",+ "THEN json_data",+ "ELSE json_build_array(json_data)",+ "END AS val",+ "FROM pgrst_payload)"]++selectBody :: SqlFragment+selectBody = "(SELECT val FROM pgrst_body)"++pgFmtLit :: SqlFragment -> SqlFragment+pgFmtLit x =+ let trimmed = trimNullChars x+ escaped = "'" <> replace "'" "''" trimmed <> "'"+ slashed = replace "\\" "\\\\" escaped in+ if "\\" `isInfixOf` escaped+ then "E" <> slashed+ else slashed++pgFmtIdent :: SqlFragment -> SqlFragment+pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\""++asCsvF :: SqlFragment+asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF+ where+ asCsvHeaderF =+ "(SELECT coalesce(string_agg(a.k, ','), '')" <>+ " FROM (" <>+ " SELECT json_object_keys(r)::TEXT as k" <>+ " FROM ( " <>+ " SELECT row_to_json(hh) as r from " <> sourceCTEName <> " as hh limit 1" <>+ " ) s" <>+ " ) a" <>+ ")"+ asCsvBodyF = "coalesce(string_agg(substring(_postgrest_t::text, 2, length(_postgrest_t::text) - 2), '\n'), '')"++asJsonF :: SqlFragment+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 "++asBinaryF :: FieldName -> SqlFragment+asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"++locationF :: [Text] -> SqlFragment+locationF pKeys = [qc|(+ WITH data AS (SELECT row_to_json(_) AS row FROM {sourceCTEName} AS _ LIMIT 1)+ SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))+ FROM data CROSS JOIN json_each_text(data.row) AS json_data+ {("WHERE json_data.key IN ('" <> intercalate "','" pKeys <> "')") `emptyOnFalse` null pKeys}+)|]++fromQi :: QualifiedIdentifier -> SqlFragment+fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n+ where+ n = qiName t+ s = qiSchema t++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++pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment+pgFmtColumn table "*" = fromQi table <> ".*"+pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c++pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment+pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp++pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment+pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _) = pgFmtField table f <> pgFmtAs fName jp alias+pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs fName jp alias++pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SqlFragment+pgFmtOrderTerm qi ot = unwords [+ toS . pgFmtField qi $ otTerm ot,+ maybe "" show $ otDirection ot,+ maybe "" show $ otNullOrder ot]++pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment+pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of+ Op op val -> pgFmtFieldOp op <> " " <> case op of+ "like" -> unknownLiteral (T.map star val)+ "ilike" -> unknownLiteral (T.map star val)+ "is" -> whiteList val+ _ -> unknownLiteral val++ 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+ Just False -> sqlOperator "in" <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "+ Just True -> emptyValForIn+ Nothing -> emptyValForIn++ Fts op lang val ->+ pgFmtFieldOp op+ <> "("+ <> maybe "" ((<> ", ") . pgFmtLit) lang+ <> unknownLiteral val+ <> ") "+ where+ pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op+ sqlOperator o = HM.lookupDefault "=" o operators+ 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"])++pgFmtJoinCondition :: JoinCondition -> SqlFragment+pgFmtJoinCondition (JoinCondition (qi, col1) (QualifiedIdentifier schema fTable, col2)) =+ pgFmtColumn qi col1 <> " = " <>+ pgFmtColumn (removeSourceCTESchema schema fTable) col2++pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment+pgFmtLogicTree qi (Expr hasNot op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")"+ where notOp = if hasNot then "NOT" else ""+pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt++pgFmtJsonPath :: JsonPath -> SqlFragment+pgFmtJsonPath = \case+ [] -> ""+ (JArrow x:xs) -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs+ (J2Arrow x:xs) -> "->>" <> pgFmtJsonOperand x <> pgFmtJsonPath xs+ where+ pgFmtJsonOperand (JKey k) = pgFmtLit k+ pgFmtJsonOperand (JIdx i) = pgFmtLit i <> "::int"++pgFmtAs :: FieldName -> JsonPath -> Maybe Alias -> SqlFragment+pgFmtAs _ [] Nothing = ""+pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of+ Just (JKey key) -> " AS " <> pgFmtIdent key+ Just (JIdx _) -> " AS " <> pgFmtIdent (fromMaybe fName lastKey)+ -- We get the lastKey because on:+ -- `select=data->1->mycol->>2`, we need to show the result as [ {"mycol": ..}, {"mycol": ..} ]+ -- `select=data->3`, we need to show the result as [ {"data": ..}, {"data": ..} ]+ where lastKey = jVal <$> find (\case JKey{} -> True; _ -> False) (jOp <$> reverse jp)+ Nothing -> ""+pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias++pgFmtSetLocal :: Text -> (Text, Text) -> SqlFragment+pgFmtSetLocal prefix (k, 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')
+ src/PostgREST/QueryBuilder/Procedure.hs view
@@ -0,0 +1,85 @@+module PostgREST.QueryBuilder.Procedure where++import Data.Maybe+import Data.Text (intercalate, unwords)+import qualified Hasql.Decoders as HD+import qualified Hasql.Encoders as HE+import qualified Hasql.Statement as H+import PostgREST.QueryBuilder.Private+import PostgREST.Types+import Protolude hiding (cast,+ intercalate, replace)+import Text.InterpolatedString.Perl6 (qc)++type ProcResults = (Maybe Int64, Int64, ByteString, ByteString)+callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bool ->+ Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->+ H.Statement ByteString (Maybe ProcResults)+callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField pgVer =+ unicodeStatement sql (param HE.unknown) decodeProc True+ where+ sql =[qc|+ WITH+ {argsRecord},+ {sourceCTEName} AS (+ {sourceBody}+ )+ SELECT+ {countResultF} AS total_result_set,+ pg_catalog.count(_postgrest_t) AS page_total,+ {bodyF} AS body,+ {responseHeaders} AS response_headers+ FROM ({selectQuery}) _postgrest_t;|]++ (argsRecord, args)+ | paramsAsSingleObject = ("_args_record AS (SELECT NULL)", "$1::json")+ | null pgArgs = (ignoredBody, "")+ | otherwise = (+ unwords [+ normalizedBody <> ",",+ "_args_record AS (",+ "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <>+ intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " " <> pgaType a) <$> pgArgs) <> ")",+ ")"]+ , intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " := _args_record." <> pgFmtIdent (pgaName a)) <$> pgArgs))++ sourceBody :: SqlFragment+ sourceBody+ | paramsAsSingleObject || null pgArgs =+ if returnsScalar+ then [qc| SELECT {fromQi qi}({args}) |]+ else [qc| SELECT * FROM {fromQi qi}({args}) |]+ | otherwise =+ if returnsScalar+ then [qc| SELECT {fromQi qi}({args}) FROM _args_record |]+ else [qc| SELECT _.*+ FROM _args_record,+ LATERAL ( SELECT * FROM {fromQi qi}({args}) ) _ |]++ bodyF+ | returnsScalar = scalarBodyF+ | isSingle = asJsonSingleF+ | asCsv = asCsvF+ | isJust binaryField = asBinaryF $ fromJust binaryField+ | otherwise = asJsonF++ scalarBodyF+ | asBinary = asBinaryF _procName+ | otherwise = unwords [+ "CASE",+ "WHEN pg_catalog.count(_postgrest_t) = 1",+ "THEN (json_agg(_postgrest_t." <> pgFmtIdent _procName <> ")->0)::character varying",+ "ELSE (json_agg(_postgrest_t." <> pgFmtIdent _procName <> "))::character varying",+ "END"]++ countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text+ _procName = qiName qi+ responseHeaders =+ if pgVer >= pgVersion96+ then "coalesce(nullif(current_setting('response.headers', true), ''), '[]')" :: Text -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15+ else "'[]'" :: Text++ decodeProc = HD.rowMaybe procRow+ procRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8+ <*> column HD.bytea <*> column HD.bytea+
+ src/PostgREST/QueryBuilder/ReadStatement.hs view
@@ -0,0 +1,32 @@+module PostgREST.QueryBuilder.ReadStatement where++import Data.Maybe+import Data.Text (intercalate)+import qualified Hasql.Encoders as HE+import qualified Hasql.Statement as H+import PostgREST.QueryBuilder.Private+import PostgREST.Types+import Protolude hiding (cast,+ intercalate, replace)+import Text.InterpolatedString.Perl6 (qc)++createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->+ H.Statement () ResultsWithCount+createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =+ unicodeStatement sql HE.noParams decodeStandard False+ where+ sql = [qc|+ WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols}+ FROM ( SELECT * FROM {sourceCTEName}) _postgrest_t |]+ countResultF = if countTotal then "("<>countQuery<>")" else "null"+ cols = intercalate ", " [+ countResultF <> " AS total_result_set",+ "pg_catalog.count(_postgrest_t) AS page_total",+ noLocationF <> " AS header",+ bodyF <> " AS body"+ ]+ bodyF+ | asCsv = asCsvF+ | isSingle = asJsonSingleF+ | isJust binaryField = asBinaryF $ fromJust binaryField+ | otherwise = asJsonF
+ src/PostgREST/QueryBuilder/WriteStatement.hs view
@@ -0,0 +1,53 @@+module PostgREST.QueryBuilder.WriteStatement where++import Data.Maybe+import Data.Text (intercalate, unwords)+import qualified Hasql.Encoders as HE+import qualified Hasql.Statement as H+import PostgREST.ApiRequest (PreferRepresentation (..))+import PostgREST.QueryBuilder.Private+import PostgREST.Types+import Protolude hiding (cast,+ intercalate, replace)+import Text.InterpolatedString.Perl6 (qc)++createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->+ PreferRepresentation -> [Text] ->+ H.Statement ByteString (Maybe ResultsWithCount)+createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys =+ unicodeStatement sql (param HE.unknown) decodeStandardMay True++ where+ sql = case rep of+ None -> [qc|+ WITH {sourceCTEName} AS ({mutateQuery})+ SELECT '', 0, {noLocationF}, '' |]+ HeadersOnly -> [qc|+ WITH {sourceCTEName} AS ({mutateQuery})+ SELECT {cols}+ FROM (SELECT 1 FROM {sourceCTEName}) _postgrest_t |]+ Full -> [qc|+ WITH {sourceCTEName} AS ({mutateQuery})+ SELECT {cols}+ FROM ({selectQuery}) _postgrest_t |]++ cols = intercalate ", " [+ "'' AS total_result_set", -- when updateing it does not make sense+ "pg_catalog.count(_postgrest_t) AS page_total",+ if isInsert+ then unwords [+ "CASE",+ "WHEN pg_catalog.count(_postgrest_t) = 1 THEN",+ "coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")",+ "ELSE " <> noLocationF,+ "END AS header"]+ else noLocationF <> "AS header",+ if rep == Full+ then bodyF <> " AS body"+ else "''"+ ]++ bodyF+ | asCsv = asCsvF+ | wantSingle = asJsonSingleF+ | otherwise = asJsonF
src/PostgREST/Types.hs view
@@ -24,7 +24,7 @@ -- | Enumeration of currently supported response content types data ContentType = CTApplicationJSON | CTSingularJSON- | CTTextCSV | CTTextPlain | CTTextHtml+ | CTTextCSV | CTTextPlain | CTOpenAPI | CTOctetStream | CTAny | CTOther ByteString deriving (Show, Eq) @@ -37,7 +37,6 @@ toMime CTApplicationJSON = "application/json" toMime CTTextCSV = "text/csv" toMime CTTextPlain = "text/plain"-toMime CTTextHtml = "text/html" toMime CTOpenAPI = "application/openapi+json" toMime CTSingularJSON = "application/vnd.pgrst.object+json" toMime CTOctetStream = "application/octet-stream"@@ -50,7 +49,6 @@ "application/json" -> CTApplicationJSON "text/csv" -> CTTextCSV "text/plain" -> CTTextPlain- "text/html" -> CTTextHtml "application/openapi+json" -> CTOpenAPI "application/vnd.pgrst.object+json" -> CTSingularJSON "application/vnd.pgrst.object" -> CTSingularJSON@@ -58,10 +56,6 @@ "*/*" -> CTAny ct' -> CTOther ct' --- | ContentTypes that can get a raw/unwrapped response-rawContentTypes :: [ContentType]-rawContentTypes = [CTOctetStream, CTTextPlain, CTTextHtml]- data PreferResolution = MergeDuplicates | IgnoreDuplicates deriving Eq instance Show PreferResolution where show MergeDuplicates = "resolution=merge-duplicates"@@ -287,7 +281,8 @@ ftsOperators = M.fromList [ ("fts", "@@ to_tsquery"), ("plfts", "@@ plainto_tsquery"),- ("phfts", "@@ phraseto_tsquery")+ ("phfts", "@@ phraseto_tsquery"),+ ("wfts", "@@ websearch_to_tsquery") ] data OpExpr = OpExpr Bool Operation deriving (Eq, Show)@@ -426,8 +421,17 @@ pgVersion100 :: PgVersion pgVersion100 = PgVersion 100000 "10" +pgVersion109 :: PgVersion+pgVersion109 = PgVersion 100009 "10.9"++pgVersion110 :: PgVersion+pgVersion110 = PgVersion 110000 "11.0"+ pgVersion112 :: PgVersion pgVersion112 = PgVersion 110002 "11.2"++pgVersion114 :: PgVersion+pgVersion114 = PgVersion 110004 "11.4" sourceCTEName :: SqlFragment sourceCTEName = "pg_source"
test/Feature/AndOrParamsSpec.hs view
@@ -7,12 +7,12 @@ import Test.Hspec.Wai import Test.Hspec.Wai.JSON -import Protolude hiding (get)+import PostgREST.Types (PgVersion, pgVersion112)+import Protolude hiding (get) import SpecHelper --spec :: SpecWith Application-spec =+spec :: PgVersion -> SpecWith Application+spec actualPgVersion = describe "and/or params used for complex boolean logic" $ do context "used with GET" $ do context "or param" $ do@@ -80,6 +80,19 @@ {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" }, {"text_search_vector": "'art':4 'spass':5 'unmog':7"} ]|] { matchHeaders = [matchContentTypeJson] }++ when (actualPgVersion >= pgVersion112) $+ it "can handle wfts (websearch_to_tsquery)" $+ get "/tsearch?or=(text_search_vector.plfts(german).Art,text_search_vector.plfts(french).amusant,text_search_vector.not.wfts(english).impossible)"+ `shouldRespondWith`+ [json|[+ {"text_search_vector": "'also':2 'fun':3 'possibl':8" },+ {"text_search_vector": "'ate':3 'cat':2 'fat':1 'rat':4" },+ {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" },+ {"text_search_vector": "'art':4 'spass':5 'unmog':7" }+ ]|]+ { matchHeaders = [matchContentTypeJson] }+ it "can handle cs and cd" $ get "/entities?or=(arr.cs.{1,2,3},arr.cd.{1})&select=id" `shouldRespondWith` [json|[{ "id": 1 },{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }@@ -113,6 +126,34 @@ [json|[{ "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] } get "/ranges?range=adj.(3,10]&select=id" `shouldRespondWith` [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] }++ it "can handle array operators" $ do+ get "/entities?arr=eq.{1,2,3}&select=id" `shouldRespondWith`+ [json|[{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }+ get "/entities?arr=neq.{1,2}&select=id" `shouldRespondWith`+ [json|[{ "id": 1 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }+ get "/entities?arr=lt.{2,3}&select=id" `shouldRespondWith`+ [json|[{ "id": 1 }, { "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }+ get "/entities?arr=lt.{2,0}&select=id" `shouldRespondWith`+ [json|[{ "id": 1 }, { "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }+ get "/entities?arr=gt.{1,1}&select=id" `shouldRespondWith`+ [json|[{ "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }+ get "/entities?arr=gt.{3}&select=id" `shouldRespondWith`+ [json|[]|] { matchHeaders = [matchContentTypeJson] }+ get "/entities?arr=lte.{2,1}&select=id" `shouldRespondWith`+ [json|[{ "id": 1 }, { "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }+ get "/entities?arr=lte.{1,2,3}&select=id" `shouldRespondWith`+ [json|[{ "id": 1 }, { "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }+ get "/entities?arr=lte.{1,2}&select=id" `shouldRespondWith`+ [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }+ get "/entities?arr=cs.{1,2}&select=id" `shouldRespondWith`+ [json|[{ "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }+ get "/entities?arr=cd.{1,2,6}&select=id" `shouldRespondWith`+ [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] }+ get "/entities?arr=ov.{3}&select=id" `shouldRespondWith`+ [json|[{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] }+ get "/entities?arr=ov.{2,3}&select=id" `shouldRespondWith`+ [json|[{ "id": 2 }, { "id": 3 }]|] { matchHeaders = [matchContentTypeJson] } context "operators with not" $ do it "eq, cs, like can be negated" $
test/Feature/AuthSpec.hs view
@@ -117,11 +117,11 @@ it "hides tables from users with invalid JWT" $ do let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" request methodGet "/authors_only" [auth] ""- `shouldRespondWith` [json| {"message":"JWSError (CompactDecodeError \"expected 3 parts, got 2\")"} |]+ `shouldRespondWith` [json| {"message":"JWSError (CompactDecodeError Invalid number of parts: Expected 3 parts; got 2)"} |] { matchStatus = 401 , matchHeaders = [ "WWW-Authenticate" <:>- "Bearer error=\"invalid_token\", error_description=\"JWSError (CompactDecodeError \\\"expected 3 parts, got 2\\\")\""+ "Bearer error=\"invalid_token\", error_description=\"JWSError (CompactDecodeError Invalid number of parts: Expected 3 parts; got 2)\"" ] }
+ test/Feature/HtmlRawOutputSpec.hs view
@@ -0,0 +1,30 @@+module Feature.HtmlRawOutputSpec where++import Network.Wai (Application)++import Network.HTTP.Types+import Test.Hspec hiding (pendingWith)+import Test.Hspec.Wai+import Text.Heredoc++import Protolude hiding (get)+import SpecHelper (acceptHdrs)++spec :: SpecWith Application+spec = describe "When raw-media-types is set to \"text/html\"" $+ it "can get raw output with Accept: text/html" $+ request methodGet "/rpc/welcome.html" (acceptHdrs "text/html") ""+ `shouldRespondWith`+ [str|+ |<html>+ | <head>+ | <title>PostgREST</title>+ | </head>+ | <body>+ | <h1>Welcome to PostgREST</h1>+ | </body>+ |</html>+ |]+ { matchStatus = 200+ , matchHeaders = ["Content-Type" <:> "text/html; charset=utf-8"]+ }
test/Feature/QuerySpec.hs view
@@ -10,11 +10,12 @@ import Text.Heredoc -import Protolude hiding (get)+import PostgREST.Types (PgVersion, pgVersion112)+import Protolude hiding (get) import SpecHelper -spec :: SpecWith Application-spec = do+spec :: PgVersion -> SpecWith Application+spec actualPgVersion = do describe "Querying a table with a column called count" $ it "should not confuse count column with pg_catalog.count aggregate" $@@ -119,6 +120,29 @@ [json| [ {"text_search_vector": "'ate':3 'cat':2 'fat':1 'rat':4" }] |] { matchHeaders = [matchContentTypeJson] } + when (actualPgVersion >= pgVersion112) $ do+ it "finds matches with websearch_to_tsquery" $+ get "/tsearch?text_search_vector=wfts.The%20Fat%20Rats" `shouldRespondWith`+ [json| [ {"text_search_vector": "'ate':3 'cat':2 'fat':1 'rat':4" }] |]+ { matchHeaders = [matchContentTypeJson] }++ it "can use boolean operators(and, or, -) in websearch_to_tsquery" $ do+ get "/tsearch?text_search_vector=wfts.fun%20and%20possible"+ `shouldRespondWith`+ [json| [ {"text_search_vector": "'also':2 'fun':3 'possibl':8"}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/tsearch?text_search_vector=wfts.impossible%20or%20possible"+ `shouldRespondWith`+ [json| [+ {"text_search_vector": "'fun':5 'imposs':9 'kind':3"},+ {"text_search_vector": "'also':2 'fun':3 'possibl':8"}]+ |]+ { matchHeaders = [matchContentTypeJson] }+ get "/tsearch?text_search_vector=wfts.fun%20and%20-possible"+ `shouldRespondWith`+ [json| [ {"text_search_vector": "'fun':5 'imposs':9 'kind':3"}] |]+ { 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" }] |]@@ -127,6 +151,12 @@ [json| [{"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" }] |] { matchHeaders = [matchContentTypeJson] } + when (actualPgVersion >= pgVersion112) $+ get "/tsearch?text_search_vector=wfts(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| [@@ -145,6 +175,13 @@ {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"}, {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|] { matchHeaders = [matchContentTypeJson] }+ when (actualPgVersion >= pgVersion112) $+ get "/tsearch?text_search_vector=not.wfts(english).impossible%20or%20fat%20or%20fun"+ `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`
+ test/Feature/RawOutputTypesSpec.hs view
@@ -0,0 +1,33 @@+module Feature.RawOutputTypesSpec where++import Network.Wai (Application)++import Network.HTTP.Types+import Test.Hspec+import Test.Hspec.Wai+import Test.Hspec.Wai.JSON++import Protolude+import SpecHelper (acceptHdrs)++spec :: SpecWith Application+spec = describe "When raw-media-types config variable is missing or left empty" $ do+ let firefoxAcceptHdrs = acceptHdrs "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"+ chromeAcceptHdrs = acceptHdrs "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3"+ it "responds json to a GET request with Firefox Accept headers" $+ request methodGet "/items?id=eq.1" firefoxAcceptHdrs ""+ `shouldRespondWith` [json| [{"id":1}] |]+ { matchHeaders= ["Content-Type" <:> "application/json; charset=utf-8"] }+ it "responds json to a GET request with Chrome Accept headers" $+ request methodGet "/items?id=eq.1" chromeAcceptHdrs ""+ `shouldRespondWith` [json| [{"id":1}] |]+ { matchHeaders= ["Content-Type" <:> "application/json; charset=utf-8"] }++ it "responds json to a GET request to RPC with Firefox Accept headers" $+ request methodGet "/rpc/get_projects_below?id=3" chromeAcceptHdrs ""+ `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","client_id":1}, {"id":2,"name":"Windows 10","client_id":1}]|]+ { matchHeaders= ["Content-Type" <:> "application/json; charset=utf-8"] }+ it "responds json to a GET request to RPC with Chrome Accept headers" $+ request methodGet "/rpc/get_projects_below?id=3" chromeAcceptHdrs ""+ `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","client_id":1}, {"id":2,"name":"Windows 10","client_id":1}]|]+ { matchHeaders= ["Content-Type" <:> "application/json; charset=utf-8"] }
test/Feature/RpcSpec.hs view
@@ -11,8 +11,9 @@ import Test.Hspec.Wai.JSON import Text.Heredoc -import PostgREST.Types (PgVersion, pgVersion100, pgVersion95,- pgVersion96)+import PostgREST.Types (PgVersion, pgVersion100, pgVersion109,+ pgVersion110, pgVersion112, pgVersion114,+ pgVersion95) import Protolude hiding (get) import SpecHelper @@ -256,38 +257,23 @@ [json|"object"|] { matchHeaders = [matchContentTypeJson] } - when (actualPgVersion <= pgVersion96) $- it "parses quoted JSON arguments as JSON (Postgres <= 9.6)" $+ when (actualPgVersion < pgVersion100) $+ it "parses quoted JSON arguments as JSON (Postgres < 10)" $ post "/rpc/json_argument" [json| { "arg": "{ \"key\": 3 }" } |] `shouldRespondWith` [json|"object"|] { matchHeaders = [matchContentTypeJson] } - when (actualPgVersion >= pgVersion100) $ do- it "parses quoted JSON arguments as JSON string (Postgres >= 10)" $ do- -- Postgres bug report:- -- https://www.postgresql.org/message-id/D6921B37-BD8E-4664-8D5F-DB3525765DCD%40vllmrt.net- -- * json_to_record fails (see following test)- -- * jsonb_to_record parses the embedded quoted JSON to a JSON string,- -- so that's probably the expected behavior for Postgres >= 10- pendingWith "Postgres >= 10 fails to parse quoted embedded JSON"+ when ((actualPgVersion >= pgVersion109 && actualPgVersion < pgVersion110)+ || actualPgVersion >= pgVersion114) $+ it "parses quoted JSON arguments as JSON string (from Postgres 10.9, 11.4)" $ post "/rpc/json_argument" [json| { "arg": "{ \"key\": 3 }" } |] `shouldRespondWith` [json|"string"|] { matchHeaders = [matchContentTypeJson] } - it "fails to parse quoted JSON arguments (Postgres >= 10)" $- -- Confirming buggy Postgres behavior (see previous test)- post "/rpc/json_argument"- [json| { "arg": "{ \"key\": 3 }" } |]- `shouldRespondWith`- [json|{"hint":null,"details":"Token \"key\" is invalid.","code":"22P02","message":"invalid input syntax for type json"}|]- { matchStatus = 400- , matchHeaders = [matchContentTypeJson]- }- context "improper input" $ do it "rejects unknown content type even if payload is good" $ do request methodPost "/rpc/sayhello"@@ -478,23 +464,6 @@ , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"] } - it "can get raw output with Accept: text/html" $- request methodGet "/rpc/welcome.html" (acceptHdrs "text/html") ""- `shouldRespondWith`- [str|- |<html>- | <head>- | <title>PostgREST</title>- | </head>- | <body>- | <h1>Welcome to PostgREST</h1>- | </body>- |</html>- |]- { matchStatus = 200- , matchHeaders = ["Content-Type" <:> "text/html; charset=utf-8"]- }- it "can get raw output with Accept: text/plain" $ request methodGet "/rpc/welcome" (acceptHdrs "text/plain") "" `shouldRespondWith` "Welcome to PostgREST"@@ -546,6 +515,10 @@ 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] }+ when (actualPgVersion >= pgVersion112) $+ get "/rpc/get_tsearch?text_search_vector=wfts.impossible" `shouldRespondWith`+ [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|]+ { matchHeaders = [matchContentTypeJson] } it "should work with an argument of custom type in public schema" $ get "/rpc/test_arg?my_arg=something" `shouldRespondWith`
test/Main.hs view
@@ -27,6 +27,7 @@ import qualified Feature.CorsSpec import qualified Feature.DeleteSpec import qualified Feature.ExtraSearchPathSpec+import qualified Feature.HtmlRawOutputSpec import qualified Feature.InsertSpec import qualified Feature.JsonOperatorSpec import qualified Feature.NoJwtSpec@@ -37,6 +38,7 @@ import qualified Feature.QueryLimitedSpec import qualified Feature.QuerySpec import qualified Feature.RangeSpec+import qualified Feature.RawOutputTypesSpec import qualified Feature.RootSpec import qualified Feature.RpcSpec import qualified Feature.SingularSpec@@ -74,6 +76,7 @@ nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn) refDbStructure pool getTime $ pure () extraSearchPathApp = return $ postgrest (testCfgExtraSearchPath testDbConn) refDbStructure pool getTime $ pure () rootSpecApp = return $ postgrest (testCfgRootSpec testDbConn) refDbStructure pool getTime $ pure ()+ htmlRawOutputApp = return $ postgrest (testCfgHtmlRawOutput testDbConn) refDbStructure pool getTime $ pure () let reset :: IO () reset = resetDb testDbConn@@ -86,21 +89,26 @@ specs = uncurry describe <$> [ ("Feature.AuthSpec" , Feature.AuthSpec.spec actualPgVersion)+ , ("Feature.RawOutputTypesSpec" , Feature.RawOutputTypesSpec.spec) , ("Feature.ConcurrentSpec" , Feature.ConcurrentSpec.spec) , ("Feature.CorsSpec" , Feature.CorsSpec.spec) , ("Feature.DeleteSpec" , Feature.DeleteSpec.spec) , ("Feature.InsertSpec" , Feature.InsertSpec.spec actualPgVersion) , ("Feature.JsonOperatorSpec" , Feature.JsonOperatorSpec.spec actualPgVersion)- , ("Feature.QuerySpec" , Feature.QuerySpec.spec)+ , ("Feature.QuerySpec" , Feature.QuerySpec.spec actualPgVersion) , ("Feature.RpcSpec" , Feature.RpcSpec.spec actualPgVersion) , ("Feature.RangeSpec" , Feature.RangeSpec.spec) , ("Feature.SingularSpec" , Feature.SingularSpec.spec) , ("Feature.StructureSpec" , Feature.StructureSpec.spec)- , ("Feature.AndOrParamsSpec" , Feature.AndOrParamsSpec.spec)+ , ("Feature.AndOrParamsSpec" , Feature.AndOrParamsSpec.spec actualPgVersion) ] ++ extraSpecs hspec $ do mapM_ (beforeAll_ reset . before withApp) specs++ -- this test runs with a raw-output-media-types set to text/html+ beforeAll_ reset . before htmlRawOutputApp $+ describe "Feature.HtmlRawOutputSpec" Feature.HtmlRawOutputSpec.spec -- this test runs with a different server flag beforeAll_ reset . before ltdApp $
test/SpecHelper.hs view
@@ -81,6 +81,8 @@ [] -- No root spec override Nothing+ -- Raw output media types+ [] testCfg :: Text -> AppConfig testCfg testDbConn = _baseCfg { configDatabase = testDbConn }@@ -130,6 +132,9 @@ testCfgRootSpec :: Text -> AppConfig testCfgRootSpec testDbConn = (testCfg testDbConn) { configRootSpec = Just $ QualifiedIdentifier "test" "root"}++testCfgHtmlRawOutput :: Text -> AppConfig+testCfgHtmlRawOutput testDbConn = (testCfg testDbConn) { configRawMediaTypes = ["text/html"] } setupDb :: Text -> IO () setupDb dbConn = do