jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Allow overriding headers Location,Content-Type,etc

Browse Source
This commit is contained in:
steve-chavez
2020-01-21 12:28:05 -05:00
committed by Steve Chavez
parent c7f78fa7fc
commit 9b1224827a
6 changed files with 98 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/App.hs
+38 -38
View File
@@ -137,7 +137,7 @@ app dbStructure proc cols conf apiRequest =
let (tableTotal, queryTotal, _ , body, gucHeaders) = row
case gucHeaders of
Left _ -> return . errorResponseFor $ GucHeadersError
Right hs -> do
Right ghdrs -> do
total <- if | plannedCount -> H.statement () explStm
| estimatedCount -> if tableTotal > (fromIntegral <$> maxRows)
then do estTotal <- H.statement () explStm
@@ -145,12 +145,14 @@ app dbStructure proc cols conf apiRequest =
else pure tableTotal
| otherwise -> pure tableTotal
let (status, contentRange) = rangeStatusHeader topLevelRange queryTotal total
headers = addHeadersIfNotIncluded
[toHeader contentType, contentRange, contentLocationH tName (iCanonicalQS apiRequest)]
(unwrapGucHeader <$> ghdrs)
rBody = if headersOnly then mempty else toS body
return $
if contentType == CTSingularJSON && queryTotal /= 1
then errorResponseFor . singularityError $ queryTotal
else responseLBS status
([toHeader contentType, contentRange, contentLocationH tName (iCanonicalQS apiRequest)] ++ (gucHToHeader <$> hs))
(if headersOnly then mempty else toS body)
else responseLBS status headers rBody
(ActionCreate, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
case mutateSqlParts tSchema tName of
@@ -161,29 +163,28 @@ app dbStructure proc cols conf apiRequest =
(contentType == CTSingularJSON) True
(contentType == CTTextCSV) (iPreferRepresentation apiRequest) pkCols pgVer
row <- H.statement (toS $ pjRaw pJson) stm
let (_, queryTotal, fs, body, gucHeaders) = row
let (_, queryTotal, fields, body, gucHeaders) = row
case gucHeaders of
Left _ -> return . errorResponseFor $ GucHeadersError
Right hdrs -> do
let headers = catMaybes [
if null fs
then Nothing
else Just $ locationH tName fs
, if iPreferRepresentation apiRequest == Full
then Just $ toHeader contentType
else Nothing
, Just $ contentRangeH 1 0 $
if shouldCount then Just queryTotal else Nothing
Right ghdrs -> do
let
(ctHeader, rBody) = if iPreferRepresentation apiRequest == Full then (toHeader contentType, toS body) else (mempty, mempty)
headers = addHeadersIfNotIncluded [
if null fields
then mempty
else locationH tName fields
, ctHeader
, contentRangeH 1 0 $ if shouldCount then Just queryTotal else Nothing
, if null pkCols && isNothing (iOnConflict apiRequest)
then Nothing
else (\x -> ("Preference-Applied", show x)) <$> iPreferResolution apiRequest
] ++ (gucHToHeader <$> hdrs)
then mempty
else maybe mempty (\x -> ("Preference-Applied", show x)) $ iPreferResolution apiRequest
] (unwrapGucHeader <$> ghdrs)
if contentType == CTSingularJSON && queryTotal /= 1
then do
HT.condemn
return . errorResponseFor . singularityError $ queryTotal
else
return . responseLBS status201 headers $ if iPreferRepresentation apiRequest == Full then toS body else mempty
return $ responseLBS status201 headers rBody
(ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
case mutateSqlParts tSchema tName of
@@ -196,22 +197,21 @@ app dbStructure proc cols conf apiRequest =
let (_, queryTotal, _, body, gucHeaders) = row
case gucHeaders of
Left _ -> return . errorResponseFor $ GucHeadersError
Right hdrs -> do
Right ghdrs -> do
let
updateIsNoOp = S.null cols
status | queryTotal == 0 && not updateIsNoOp = status404
| iPreferRepresentation apiRequest == Full = status200
| otherwise = status204
contentRangeHeader = contentRangeH 0 (queryTotal - 1) $ if shouldCount then Just queryTotal else Nothing
headers = [contentRangeHeader] ++
[if iPreferRepresentation apiRequest == Full then toHeader contentType else mempty] ++
(gucHToHeader <$> hdrs)
(ctHeader, rBody) = if iPreferRepresentation apiRequest == Full then (toHeader contentType, toS body) else (mempty, mempty)
headers = addHeadersIfNotIncluded [contentRangeHeader, ctHeader] (unwrapGucHeader <$> ghdrs)
if contentType == CTSingularJSON && queryTotal /= 1
then do
HT.condemn
return . errorResponseFor . singularityError $ queryTotal
else
return . responseLBS status headers $ if iPreferRepresentation apiRequest == Full then toS body else mempty
return $ responseLBS status headers rBody
(ActionSingleUpsert, TargetIdent (QualifiedIdentifier tSchema tName), Just ProcessedJSON{pjRaw, pjType, pjKeys}) ->
case mutateSqlParts tSchema tName of
@@ -234,9 +234,9 @@ app dbStructure proc cols conf apiRequest =
let (_, queryTotal, _, body, gucHeaders) = row
case gucHeaders of
Left _ -> return . errorResponseFor $ GucHeadersError
Right hdrs -> do
let headers = toHeader contentType : (gucHToHeader <$> hdrs)
status = if iPreferRepresentation apiRequest == Full then status200 else status204
Right ghdrs -> do
let headers = addHeadersIfNotIncluded [toHeader contentType] (unwrapGucHeader <$> ghdrs)
(status, rBody) = if iPreferRepresentation apiRequest == Full then (status200, toS body) else (status204, mempty)
-- Makes sure the querystring pk matches the payload pk
-- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted, PUT /items?id=eq.14 { "id" : 2, .. } is rejected
-- If this condition is not satisfied then nothing is inserted, check the WHERE for INSERT in QueryBuilder.hs to see how it's done
@@ -245,7 +245,7 @@ app dbStructure proc cols conf apiRequest =
HT.condemn
return . errorResponseFor $ PutMatchingPkError
else
return . responseLBS status headers $ if iPreferRepresentation apiRequest == Full then toS body else mempty
return $ responseLBS status headers rBody
(ActionDelete, TargetIdent (QualifiedIdentifier tSchema tName), Nothing) ->
case mutateSqlParts tSchema tName of
@@ -259,20 +259,19 @@ app dbStructure proc cols conf apiRequest =
let (_, queryTotal, _, body, gucHeaders) = row
case gucHeaders of
Left _ -> return . errorResponseFor $ GucHeadersError
Right hdrs -> do
Right ghdrs -> do
let
status = if iPreferRepresentation apiRequest == Full then status200 else status204
contentRangeHeader = contentRangeH 1 0 $ if shouldCount then Just queryTotal else Nothing
headers = [contentRangeHeader] ++
[if iPreferRepresentation apiRequest == Full then toHeader contentType else mempty] ++
(gucHToHeader <$> hdrs)
(ctHeader, rBody) = if iPreferRepresentation apiRequest == Full then (toHeader contentType, toS body) else (mempty, mempty)
headers = addHeadersIfNotIncluded [contentRangeHeader, ctHeader] (unwrapGucHeader <$> ghdrs)
if contentType == CTSingularJSON
&& queryTotal /= 1
then do
HT.condemn
return . errorResponseFor . singularityError $ queryTotal
else
return . responseLBS status headers $ if iPreferRepresentation apiRequest == Full then toS body else mempty
return $ responseLBS status headers rBody
(ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) ->
let mTable = find (\t -> tableName t == tTable && tableSchema t == tSchema) (dbTables dbStructure) in
@@ -296,17 +295,18 @@ app dbStructure proc cols conf apiRequest =
bField pgVer
row <- H.statement (toS $ pjRaw pJson) stm
let (tableTotal, queryTotal, body, gucHeaders) = row
(status, contentRange) = rangeStatusHeader topLevelRange queryTotal tableTotal
case gucHeaders of
Left _ -> return . errorResponseFor $ GucHeadersError
Right hs ->
Right ghdrs -> do
let (status, contentRange) = rangeStatusHeader topLevelRange queryTotal tableTotal
headers = addHeadersIfNotIncluded [toHeader contentType, contentRange] (unwrapGucHeader <$> ghdrs)
rBody = if invMethod == InvHead then mempty else toS body
if contentType == CTSingularJSON && queryTotal /= 1
then do
HT.condemn
return . errorResponseFor . singularityError $ queryTotal
else
return $ responseLBS status ([toHeader contentType, contentRange] ++ (gucHToHeader <$> hs))
(if invMethod == InvHead then mempty else toS body)
return $ responseLBS status headers rBody
(ActionInspect headersOnly, TargetDefaultSpec tSchema, Nothing) -> do
let host = configHost conf
@@ -395,7 +395,7 @@ binaryField ct rawContentTypes isScalarProc readReq
locationH :: TableName -> [BS.ByteString] -> Header
locationH tName fields =
let
locationFields = renderSimpleQuery True $ map splitKeyValue fields
locationFields = renderSimpleQuery True $ splitKeyValue <$> fields
in
(hLocation, "/" <> toS tName <> locationFields)
where
src/PostgREST/Types.hs
+11 -4
View File
@@ -399,17 +399,24 @@ type RpcQParam = (Text, Text)
Custom guc header, it's obtained by parsing the json in a:
`SET LOCAL "response.headers" = '[{"Set-Cookie": ".."}]'
-}
newtype GucHeader = GucHeader (Text, Text)
newtype GucHeader = GucHeader (CI.CI ByteString, ByteString)
deriving (Show, Eq)
instance JSON.FromJSON GucHeader where
parseJSON (JSON.Object o) = case headMay (M.toList o) of
Just (k, JSON.String s) | M.size o == 1 -> pure $ GucHeader (k, s)
Just (k, JSON.String s) | M.size o == 1 -> pure $ GucHeader (CI.mk $ toS k, toS s)
| otherwise -> mzero
_ -> mzero
parseJSON _ = mzero
gucHToHeader :: GucHeader -> Header
gucHToHeader (GucHeader (k, v)) = (CI.mk $ toS k, toS v)
unwrapGucHeader :: GucHeader -> Header
unwrapGucHeader (GucHeader (k, v)) = (k, v)
-- | Add headers not already included to allow the user to override them instead of duplicating them
addHeadersIfNotIncluded :: [Header] -> [Header] -> [Header]
addHeadersIfNotIncluded newHeaders initialHeaders =
filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++
initialHeaders
{-|
This type will hold information about which particular 'Relation' between two tables to choose when there are multiple ones.