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

refactor: untangle query logic from response logic

Browse Source 
* untangle failNotSingular
* untangle failsChangesOffLimits
* untangle readTotal
This commit is contained in:
steve-chavez
2022-09-25 13:53:11 -05:00
committed by Steve Chavez
parent c27e7be028
commit 92e28bd902
2 changed files with 46 additions and 46 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/App.hs
+30 -30
View File
@@ -280,9 +280,11 @@ handleRead headersOnly identifier context@RequestContext{..} = do
bField bField
configDbPreparedStatements configDbPreparedStatements
failNotSingular iAcceptMediaType resultSet
total <- readTotal ctxConfig ctxApiRequest resultSet countQuery
case resultSet of case resultSet of
RSStandard{..} -> do RSStandard{..} -> do
total <- readTotal ctxConfig ctxApiRequest rsTableTotal countQuery
let let
(status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal total (status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal total
@@ -301,14 +303,14 @@ handleRead headersOnly identifier context@RequestContext{..} = do
$ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show total) $ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show total)
else LBS.fromStrict rsBody else LBS.fromStrict rsBody
failNotSingular iAcceptMediaType rsQueryTotal . response status headers $ pure $ response status headers $ if headersOnly then mempty else rsOrErrBody
if headersOnly then mempty else rsOrErrBody
RSPlan plan -> RSPlan plan ->
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
readTotal :: AppConfig -> ApiRequest -> Maybe Int64 -> SQL.Snippet -> DbHandler (Maybe Int64) readTotal :: AppConfig -> ApiRequest -> ResultSet -> SQL.Snippet -> DbHandler (Maybe Int64)
readTotal AppConfig{..} ApiRequest{..} tableTotal countQuery = readTotal _ _ RSPlan{} _ = pure Nothing
readTotal AppConfig{..} ApiRequest{..} RSStandard{rsTableTotal=tableTotal} countQuery =
case iPreferCount of case iPreferCount of
Just PlannedCount -> Just PlannedCount ->
explain explain
@@ -334,6 +336,8 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
resultSet <- writeQuery MutationCreate identifier True pkCols context resultSet <- writeQuery MutationCreate identifier True pkCols context
failNotSingular iAcceptMediaType resultSet
case resultSet of case resultSet of
RSStandard{..} -> do RSStandard{..} -> do
let let
@@ -357,8 +361,7 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
toAppliedHeader <$> iPreferResolution toAppliedHeader <$> iPreferResolution
] ]
failNotSingular iAcceptMediaType rsQueryTotal $ pure $ if iPreferRepresentation == Full then
if iPreferRepresentation == Full then
response HTTP.status201 (headers ++ contentTypeHeaders context) (LBS.fromStrict rsBody) response HTTP.status201 (headers ++ contentTypeHeaders context) (LBS.fromStrict rsBody)
else else
response HTTP.status201 headers mempty response HTTP.status201 headers mempty
@@ -369,6 +372,8 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
resultSet <- writeQuery MutationUpdate identifier False mempty context resultSet <- writeQuery MutationUpdate identifier False mempty context
failNotSingular iAcceptMediaType resultSet
failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
case resultSet of case resultSet of
RSStandard{..} -> do RSStandard{..} -> do
@@ -384,12 +389,10 @@ handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $ RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
if shouldCount iPreferCount then Just rsQueryTotal else Nothing if shouldCount iPreferCount then Just rsQueryTotal else Nothing
failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<< pure $ if fullRepr then
failNotSingular iAcceptMediaType rsQueryTotal (
if fullRepr then
response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict rsBody) response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict rsBody)
else else
response status [contentRangeHeader] mempty) response status [contentRangeHeader] mempty
RSPlan plan -> RSPlan plan ->
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
@@ -426,6 +429,8 @@ handleSingleUpsert identifier context@(RequestContext _ ctxDbStructure ApiReques
handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _) = do handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _) = do
resultSet <- writeQuery MutationDelete identifier False mempty context resultSet <- writeQuery MutationDelete identifier False mempty context
failNotSingular iAcceptMediaType resultSet
failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
case resultSet of case resultSet of
RSStandard {..} -> do RSStandard {..} -> do
@@ -435,14 +440,12 @@ handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _) = do
RangeQuery.contentRangeH 1 0 $ RangeQuery.contentRangeH 1 0 $
if shouldCount iPreferCount then Just rsQueryTotal else Nothing if shouldCount iPreferCount then Just rsQueryTotal else Nothing
failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<< pure $ if iPreferRepresentation == Full then
failNotSingular iAcceptMediaType rsQueryTotal (
if iPreferRepresentation == Full then
response HTTP.status200 response HTTP.status200
(contentTypeHeaders context ++ [contentRangeHeader]) (contentTypeHeaders context ++ [contentRangeHeader])
(LBS.fromStrict rsBody) (LBS.fromStrict rsBody)
else else
response HTTP.status204 [contentRangeHeader] mempty) response HTTP.status204 [contentRangeHeader] mempty
RSPlan plan -> RSPlan plan ->
pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
@@ -499,6 +502,8 @@ handleInvoke invMethod proc context@RequestContext{..} = do
bField bField
(configDbPreparedStatements ctxConfig) (configDbPreparedStatements ctxConfig)
failNotSingular iAcceptMediaType resultSet
case resultSet of case resultSet of
RSStandard {..} -> do RSStandard {..} -> do
let let
@@ -510,8 +515,7 @@ handleInvoke invMethod proc context@RequestContext{..} = do
$ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal) $ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal)
else LBS.fromStrict rsBody else LBS.fromStrict rsBody
failNotSingular iAcceptMediaType rsQueryTotal $ pure $ if Proc.procReturnsVoid proc then
if Proc.procReturnsVoid proc then
response HTTP.status204 [contentRange] mempty response HTTP.status204 [contentRange] mempty
else else
response status response status
@@ -608,24 +612,20 @@ decodeGucStatus =
-- | -- |
-- Fail a response if a single JSON object was requested and not exactly one -- Fail a response if a single JSON object was requested and not exactly one
-- was found. -- was found.
failNotSingular :: MediaType -> Int64 -> Wai.Response -> DbHandler Wai.Response failNotSingular :: MediaType -> ResultSet -> DbHandler ()
failNotSingular mediaType queryTotal response = failNotSingular _ RSPlan{} = pure ()
if mediaType == MTSingularJSON && queryTotal /= 1 then failNotSingular mediaType RSStandard{rsQueryTotal=queryTotal} =
do when (mediaType == MTSingularJSON && queryTotal /= 1) $ do
lift SQL.condemn lift SQL.condemn
throwError $ Error.singularityError queryTotal throwError $ Error.singularityError queryTotal
else
return response
failChangesOffLimits :: Maybe Integer -> Int64 -> Wai.Response -> DbHandler Wai.Response failsChangesOffLimits :: Maybe Integer -> ResultSet -> DbHandler ()
failChangesOffLimits (Just maxChanges) queryTotal response = failsChangesOffLimits _ RSPlan{} = pure ()
if queryTotal > fromIntegral maxChanges failsChangesOffLimits Nothing _ = pure ()
then do failsChangesOffLimits (Just maxChanges) RSStandard{rsQueryTotal=queryTotal} =
when (queryTotal > fromIntegral maxChanges) $ do
lift SQL.condemn lift SQL.condemn
throwError $ Error.OffLimitsChangesError queryTotal maxChanges throwError $ Error.OffLimitsChangesError queryTotal maxChanges
else
return response
failChangesOffLimits _ _ response = return response
shouldCount :: Maybe PreferCount -> Bool shouldCount :: Maybe PreferCount -> Bool
shouldCount preferCount = shouldCount preferCount =