diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -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
diff --git a/postgrest.cabal b/postgrest.cabal
--- a/postgrest.cabal
+++ b/postgrest.cabal
@@ -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
diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -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 "*"
diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs
--- a/src/PostgREST/Config.hs
+++ b/src/PostgREST/Config.hs
@@ -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
diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs
--- a/src/PostgREST/QueryBuilder.hs
+++ b/src/PostgREST/QueryBuilder.hs
@@ -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')
diff --git a/src/PostgREST/QueryBuilder/Private.hs b/src/PostgREST/QueryBuilder/Private.hs
new file mode 100644
--- /dev/null
+++ b/src/PostgREST/QueryBuilder/Private.hs
@@ -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')
diff --git a/src/PostgREST/QueryBuilder/Procedure.hs b/src/PostgREST/QueryBuilder/Procedure.hs
new file mode 100644
--- /dev/null
+++ b/src/PostgREST/QueryBuilder/Procedure.hs
@@ -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
+
diff --git a/src/PostgREST/QueryBuilder/ReadStatement.hs b/src/PostgREST/QueryBuilder/ReadStatement.hs
new file mode 100644
--- /dev/null
+++ b/src/PostgREST/QueryBuilder/ReadStatement.hs
@@ -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
diff --git a/src/PostgREST/QueryBuilder/WriteStatement.hs b/src/PostgREST/QueryBuilder/WriteStatement.hs
new file mode 100644
--- /dev/null
+++ b/src/PostgREST/QueryBuilder/WriteStatement.hs
@@ -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
diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs
--- a/src/PostgREST/Types.hs
+++ b/src/PostgREST/Types.hs
@@ -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"
diff --git a/test/Feature/AndOrParamsSpec.hs b/test/Feature/AndOrParamsSpec.hs
--- a/test/Feature/AndOrParamsSpec.hs
+++ b/test/Feature/AndOrParamsSpec.hs
@@ -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" $
diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs
--- a/test/Feature/AuthSpec.hs
+++ b/test/Feature/AuthSpec.hs
@@ -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)\""
]
}
diff --git a/test/Feature/HtmlRawOutputSpec.hs b/test/Feature/HtmlRawOutputSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Feature/HtmlRawOutputSpec.hs
@@ -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|
+ |
+ |
+ | PostgREST
+ |
+ |
+ | Welcome to PostgREST
+ |
+ |
+ |]
+ { matchStatus = 200
+ , matchHeaders = ["Content-Type" <:> "text/html; charset=utf-8"]
+ }
diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs
--- a/test/Feature/QuerySpec.hs
+++ b/test/Feature/QuerySpec.hs
@@ -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`
diff --git a/test/Feature/RawOutputTypesSpec.hs b/test/Feature/RawOutputTypesSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Feature/RawOutputTypesSpec.hs
@@ -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"] }
diff --git a/test/Feature/RpcSpec.hs b/test/Feature/RpcSpec.hs
--- a/test/Feature/RpcSpec.hs
+++ b/test/Feature/RpcSpec.hs
@@ -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|
- |
- |
- | PostgREST
- |
- |
- | Welcome to PostgREST
- |
- |
- |]
- { 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`
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -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 $
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -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