Fix #690, add columns query arg for RPC/POST/PATCH

* Refactor normalizing json CTE
* Refactor CTE to use CASE instead of UNION
This commit is contained in:
steve-chavez
2019-02-26 11:38:21 -05:00
committed by Steve Chávez
parent 3946dfbc64
commit c9b2830e52
10 changed files with 157 additions and 70 deletions
+23 -12
View File
@@ -19,6 +19,7 @@ import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS (c2w)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Csv as CSV
import Data.Either.Combinators (mapLeft)
import qualified Data.List as L
import Data.List (lookup, last, partition)
import qualified Data.HashMap.Strict as M
@@ -32,6 +33,7 @@ import Network.HTTP.Types.Header (hAuthorization, hCookie)
import Network.HTTP.Types.URI (parseSimpleQuery)
import Network.Wai (Request (..))
import Network.Wai.Parse (parseHttpAccept)
import PostgREST.Parsers (pRequestColumns)
import PostgREST.RangeQuery (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange, rangeLimit, rangeOffset)
import Data.Ranged.Boundaries
import PostgREST.Types
@@ -120,7 +122,7 @@ userApiRequest schema req reqBody
else Nothing
, iFilters = filters
, iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
, iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
, iSelect = toS $ fromMaybe "*" $ join $ lookup "select" qParams
, iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
, iCanonicalQS = toS $ urlEncodeVars
. L.sortBy (comparing fst)
@@ -137,28 +139,37 @@ userApiRequest schema req reqBody
case action of
ActionInvoke{isReadOnly=True} -> partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
_ -> (flts, [])
flts = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
flts =
[ (toS k, toS $ fromJust v) |
(k,v) <- qParams, isJust v,
k `notElem` ["select", "columns"],
not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
hasOperator val = any (`T.isPrefixOf` val) $
((<> ".") <$> "not":M.keys operators) ++
((<> "(") <$> M.keys ftsOperators)
isEmbedPath = T.isInfixOf "."
isTargetingProc = (== Just "rpc") $ listToMaybe path
contentType = decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type"
payload =
case (decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type", action) of
case (contentType, action) of
(_, ActionInvoke{isReadOnly=True}) ->
Right $ PayloadJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> rpcQParams) PJObject (S.fromList $ fst <$> rpcQParams)
Right $ ProcessedJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> rpcQParams) PJObject (S.fromList $ fst <$> rpcQParams)
(CTApplicationJSON, _) ->
note "All object keys must match" . payloadAttributes reqBody
=<< if BL.null reqBody && isTargetingProc
then Right emptyObject
else JSON.eitherDecode reqBody
let columns | action `elem` [ActionCreate, ActionUpdate, ActionInvoke{isReadOnly=False}] = toS <$> join (lookup "columns" qParams)
| otherwise = Nothing in
case columns of
Just cols -> RawJSON reqBody <$> mapLeft show (pRequestColumns cols)
Nothing -> note "All object keys must match" . payloadAttributes reqBody
=<< if BL.null reqBody && isTargetingProc
then Right emptyObject
else JSON.eitherDecode reqBody
(CTTextCSV, _) -> do
json <- csvToJson <$> CSV.decodeByName reqBody
note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json
(CTOther "application/x-www-form-urlencoded", _) ->
let json = M.fromList . map (toS *** JSON.String . toS) . parseSimpleQuery $ toS reqBody
keys = S.fromList $ M.keys json in
Right $ PayloadJSON (JSON.encode json) PJObject keys
Right $ ProcessedJSON (JSON.encode json) PJObject keys
(ct, _) ->
Left $ toS $ "Content-Type not acceptable: " <> toMime ct
topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges
@@ -291,14 +302,14 @@ payloadAttributes raw json =
JSON.Object x -> S.fromList (M.keys x) == canonicalKeys
_ -> False) arr in
if areKeysUniform
then Just $ PayloadJSON raw (PJArray $ V.length arr) canonicalKeys
then Just $ ProcessedJSON raw (PJArray $ V.length arr) canonicalKeys
else Nothing
Just _ -> Nothing
Nothing -> Just emptyPJArray
JSON.Object o -> Just $ PayloadJSON raw PJObject (S.fromList $ M.keys o)
JSON.Object o -> Just $ ProcessedJSON raw PJObject (S.fromList $ M.keys o)
-- truncate everything else to an empty array.
_ -> Just emptyPJArray
where
emptyPJArray = PayloadJSON (JSON.encode emptyArray) (PJArray 0) S.empty
emptyPJArray = ProcessedJSON (JSON.encode emptyArray) (PJArray 0) S.empty
+10 -11
View File
@@ -78,10 +78,9 @@ postgrest conf refDbStructure pool getTime worker =
Left err -> return $ apiRequestError err
Right apiRequest -> do
eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) time (rightToMaybe $ configRoleClaimKey conf)
let authed = containsRole eClaims
proc = case (iTarget apiRequest, iPayload apiRequest, iPreferSingleObjectParameter apiRequest) of
(TargetProc qi, Just PayloadJSON{pjKeys}, s) -> findProc qi pjKeys s $ dbProcs dbStructure
(TargetProc qi, Just pJson, s) -> findProc qi (pjKeys pJson) s $ dbProcs dbStructure
_ -> Nothing
handleReq = runWithClaims conf eClaims (app dbStructure proc conf) apiRequest
txMode = transactionMode proc (iAction apiRequest)
@@ -109,7 +108,7 @@ transactionMode proc action =
ActionInfo -> HT.Read
ActionInspect -> HT.Read
ActionInvoke{isReadOnly=False} ->
let v = maybe Volatile pdVolatility proc in
let v = maybe Volatile pdVolatility proc in
if v == Stable || v == Immutable
then HT.Read
else HT.Write
@@ -146,7 +145,7 @@ app dbStructure proc conf apiRequest =
)
] (toS body)
(ActionCreate, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw}) ->
(ActionCreate, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
case mutateSqlParts tSchema tName of
Left errorResponse -> return errorResponse
Right (sq, mq) -> do
@@ -154,7 +153,7 @@ app dbStructure proc conf apiRequest =
stm = createWriteStatement sq mq
(contentType == CTSingularJSON) True
(contentType == CTTextCSV) (iPreferRepresentation apiRequest) pkCols
row <- H.statement (toS pjRaw) stm
row <- H.statement (toS $ pjRaw pJson) stm
let (_, queryTotal, fs, body) = extractQueryResult row
headers = catMaybes [
if null fs
@@ -180,14 +179,14 @@ app dbStructure proc conf apiRequest =
if iPreferRepresentation apiRequest == Full
then toS body else ""
(ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw}) ->
(ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
case mutateSqlParts tSchema tName of
Left errorResponse -> return errorResponse
Right (sq, mq) -> do
let stm = createWriteStatement sq mq
(contentType == CTSingularJSON) False (contentType == CTTextCSV)
(iPreferRepresentation apiRequest) []
row <- H.statement (toS pjRaw) stm
row <- H.statement (toS $ pjRaw pJson) stm
let (_, queryTotal, _, body) = extractQueryResult row
if contentType == CTSingularJSON
&& queryTotal /= 1
@@ -205,7 +204,7 @@ app dbStructure proc conf apiRequest =
then responseLBS s [toHeader contentType, r] (toS body)
else responseLBS s [r] ""
(ActionSingleUpsert, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw, pjType, pjKeys}) ->
(ActionSingleUpsert, TargetIdent (QualifiedIdentifier tSchema tName), Just ProcessedJSON{pjRaw, pjType, pjKeys}) ->
case mutateSqlParts tSchema tName of
Left errorResponse -> return errorResponse
Right (sq, mq) -> do
@@ -267,7 +266,7 @@ app dbStructure proc conf apiRequest =
let acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
return $ responseLBS status200 [allOrigins, acceptH] ""
(ActionInvoke _, TargetProc qi, Just PayloadJSON{pjRaw, pjKeys}) ->
(ActionInvoke _, TargetProc qi, Just pJson) ->
let returnsScalar = case proc of
Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
_ -> False
@@ -279,8 +278,8 @@ app dbStructure proc conf apiRequest =
Left errorResponse -> return errorResponse
Right ((q, cq), bField) -> do
let singular = contentType == CTSingularJSON
specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ maybe [] pdArgs proc
row <- H.statement (toS pjRaw) $
specifiedPgArgs = filter ((`S.member` pjKeys pJson) . pgaName) $ maybe [] pdArgs proc
row <- H.statement (toS $ pjRaw pJson) $
callProc qi specifiedPgArgs returnsScalar q cq shouldCount
singular (iPreferSingleObjectParameter apiRequest)
(contentType == CTTextCSV)
+4 -4
View File
@@ -321,8 +321,8 @@ addProperty f (targetNodeName:remainingPath, a) (Node rn forest) =
mutateRequest :: ApiRequest -> TableName -> [Text] -> [FieldName] -> Either Response MutateRequest
mutateRequest apiRequest tName pkCols fldNames = mapLeft apiRequestError $
case action of
ActionCreate -> Right $ Insert tName (pjKeys payload) ((,) <$> iPreferResolution apiRequest <*> Just pkCols) [] returnings
ActionUpdate -> Update tName (pjKeys payload) <$> combinedLogic <*> pure returnings
ActionCreate -> Right $ Insert tName pjCols ((,) <$> iPreferResolution apiRequest <*> Just pkCols) [] returnings
ActionUpdate -> Update tName pjCols <$> combinedLogic <*> pure returnings
ActionSingleUpsert ->
(\flts ->
if null (iLogic apiRequest) &&
@@ -331,14 +331,14 @@ mutateRequest apiRequest tName pkCols fldNames = mapLeft apiRequestError $
all (\case
Filter _ (OpExpr False (Op "eq" _)) -> True
_ -> False) flts
then Insert tName (pjKeys payload) (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
then Insert tName pjCols (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
else
Left InvalidFilters) =<< filters
ActionDelete -> Delete tName <$> combinedLogic <*> pure returnings
_ -> Left UnsupportedVerb
where
action = iAction apiRequest
payload = fromJust $ iPayload apiRequest
pjCols = pjKeys $ fromJust $ iPayload apiRequest
returnings = if iPreferRepresentation apiRequest == None then [] else fldNames
filters = map snd <$> mapM pRequestFilter mutateFilters
logic = map snd <$> mapM pRequestLogicTree logicFilters
+8
View File
@@ -13,6 +13,7 @@ import Data.Functor (($>))
import qualified Data.HashMap.Strict as M
import Data.Text (intercalate, replace, strip)
import Data.List (init, last)
import qualified Data.Set as S
import Data.Tree
import Data.Either.Combinators (mapLeft)
import PostgREST.RangeQuery (NonnegRange)
@@ -217,6 +218,13 @@ pLogicPath = do
notOp = "not." <> op
return (filter (/= "not") (init path), if "not" `elem` path then notOp else op)
pRequestColumns :: Text -> Either ParseError (S.Set FieldName)
pRequestColumns colStr =
S.fromList <$> parse pColumns ("failed to parse columns parameter (" <> toS colStr <> ")") (toS colStr)
pColumns :: Parser [FieldName]
pColumns = pFieldName `sepBy1` lexeme (char ',')
mapError :: Either ParseError a -> Either ApiRequestError a
mapError = mapLeft translateError
where
+25 -19
View File
@@ -177,13 +177,9 @@ callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle para
| null pgArgs = (ignoredBody, "")
| otherwise = (
unwords [
"payload AS (SELECT $1::json AS json_data),",
"vals AS (",
"SELECT json_data AS val FROM payload WHERE json_typeof(json_data) = 'array'",
"UNION ALL",
"SELECT json_build_array(json_data) AS val FROM payload WHERE json_typeof(json_data) = 'object'),",
normalizedBody <> ",",
"_args_record AS (",
"SELECT * FROM json_to_recordset((SELECT val FROM vals)) AS _(" <>
"SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <>
intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " " <> pgaType a) <$> pgArgs) <> ")",
")"]
, intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " := (SELECT " <> pgFmtIdent (pgaName a) <> " FROM _args_record)") <$> pgArgs))
@@ -276,16 +272,11 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbl tblAlias imp
getQueryParts _ _ = witness
requestToQuery schema _ (DbMutate (Insert mainTbl iCols onConflct putConditions returnings)) =
unwords [
"WITH payload AS (SELECT $1::json AS json_data),",
"vals AS (",
unwords [
"SELECT json_data AS val FROM payload WHERE json_typeof(json_data) = 'array'",
"UNION ALL",
"SELECT json_build_array(json_data) AS val FROM payload WHERE json_typeof(json_data) = 'object')"],
"WITH " <> normalizedBody,
"INSERT INTO ", fromQi qi, if S.null iCols then " " else "(" <> cols <> ")",
unwords [
"SELECT " <> cols <> " FROM",
"json_populate_recordset", "(null::", fromQi qi, ", (SELECT val FROM vals)) _",
"json_populate_recordset", "(null::", fromQi qi, ", " <> selectBody <> ") _",
-- Only used for PUT
("WHERE " <> intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier "" "_") <$> putConditions)) `emptyOnFalse` null putConditions],
maybe "" (\(oncDo, oncCols) -> (
@@ -304,13 +295,9 @@ requestToQuery schema _ (DbMutate (Update mainTbl uCols logicForest returnings))
then "WITH " <> ignoredBody <> "SELECT null WHERE false" -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
else
unwords [
"WITH payload AS (SELECT $1::json AS json_data),",
"vals AS (",
"SELECT json_data AS val FROM payload WHERE json_typeof(json_data) = 'array'",
"UNION ALL",
"SELECT json_build_array(json_data) AS val FROM payload WHERE json_typeof(json_data) = 'object')",
"WITH " <> normalizedBody,
"UPDATE " <> fromQi qi <> " SET " <> cols,
"FROM (SELECT * FROM json_populate_recordset", "(null::", fromQi qi, ", (SELECT val FROM vals))) _ ",
"FROM (SELECT * FROM json_populate_recordset", "(null::", fromQi qi, ", " <> selectBody <> ")) _ ",
("WHERE " <> intercalate " AND " (pgFmtLogicTree qi <$> logicForest)) `emptyOnFalse` null logicForest,
("RETURNING " <> intercalate ", " (pgFmtColumn qi <$> returnings)) `emptyOnFalse` null returnings
]
@@ -334,6 +321,25 @@ requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) =
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
+15 -10
View File
@@ -187,16 +187,21 @@ data Relation = Relation {
isSelfJoin :: Relation -> Bool
isSelfJoin r = relType r /= Root && relTable r == relFTable r
-- | Cached attributes of a JSON payload
data PayloadJSON = PayloadJSON {
-- | This is the raw ByteString that comes from the request body.
-- We cache this instead of an Aeson Value because it was detected that for large payloads the encoding
-- had high memory usage, see #1005 for more details
pjRaw :: BL.ByteString
, pjType :: PJType
-- | Keys of the object or if it's an array these keys are guaranteed to be the same across all its objects
, pjKeys :: S.Set Text
} deriving (Show, Eq)
data PayloadJSON =
-- | Cached attributes of a JSON payload
ProcessedJSON {
-- | This is the raw ByteString that comes from the request body.
-- We cache this instead of an Aeson Value because it was detected that for large payloads the encoding
-- had high memory usage, see #1005 for more details
pjRaw :: BL.ByteString
, pjType :: PJType
-- | Keys of the object or if it's an array these keys are guaranteed to be the same across all its objects
, pjKeys :: S.Set Text
}|
RawJSON {
pjRaw :: BL.ByteString
, pjKeys :: S.Set Text
} deriving (Show, Eq)
data PJType = PJArray { pjaLength :: Int } | PJObject deriving (Show, Eq)