refactor: untangle query logic from response logic

* untangle failNotSingular
* untangle failsChangesOffLimits
* untangle readTotal

src/PostgREST/App.hs

@@ -30,7 +30,7 @@ import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
                                  setServerName)
 import System.Posix.Types       (FileMode)
 
-import qualified Data.Aeson                        as JSON
+import qualified Data.Aeson                      as JSON
 import qualified Data.ByteString.Char8           as BS
 import qualified Data.ByteString.Lazy            as LBS
 import qualified Data.HashMap.Strict             as HM
@@ -280,9 +280,11 @@ handleRead headersOnly identifier context@RequestContext{..} = do
         bField
         configDbPreparedStatements
 
+  failNotSingular iAcceptMediaType resultSet
+  total <- readTotal ctxConfig ctxApiRequest resultSet countQuery
+
   case resultSet of
     RSStandard{..} -> do
-      total <- readTotal ctxConfig ctxApiRequest rsTableTotal countQuery
 
       let
         (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)
           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 ->
       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
     Just PlannedCount ->
       explain
@@ -334,6 +336,8 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
 
   resultSet <- writeQuery MutationCreate identifier True pkCols context
 
+  failNotSingular iAcceptMediaType resultSet
+
   case resultSet of
     RSStandard{..} -> do
       let
@@ -357,11 +361,10 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
                 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
 
     RSPlan plan ->
       pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
@@ -369,6 +372,8 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do
 handleUpdate :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
 handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
   resultSet <- writeQuery MutationUpdate identifier False mempty context
+  failNotSingular iAcceptMediaType resultSet
+  failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
 
   case resultSet of
     RSStandard{..} -> do
@@ -384,12 +389,10 @@ handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do
           RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
             if shouldCount iPreferCount then Just rsQueryTotal else Nothing
 
-      failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<<
+      pure $ if fullRepr then
-        failNotSingular iAcceptMediaType rsQueryTotal (
+          response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict rsBody)
-          if fullRepr then
+        else
-            response status (contentTypeHeaders context ++ [contentRangeHeader]) (LBS.fromStrict rsBody)
+          response status [contentRangeHeader] mempty
-          else
-            response status [contentRangeHeader] mempty)
 
     RSPlan 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 identifier context@(RequestContext _ _ ApiRequest{..} _) = do
   resultSet <- writeQuery MutationDelete identifier False mempty context
+  failNotSingular iAcceptMediaType resultSet
+  failsChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) resultSet
 
   case resultSet of
     RSStandard {..} -> do
@@ -435,14 +440,12 @@ handleDelete identifier context@(RequestContext _ _ ApiRequest{..} _) = do
           RangeQuery.contentRangeH 1 0 $
             if shouldCount iPreferCount then Just rsQueryTotal else Nothing
 
-      failChangesOffLimits (RangeQuery.rangeLimit iTopLevelRange) rsQueryTotal =<<
+      pure $ if iPreferRepresentation == Full then
-        failNotSingular iAcceptMediaType rsQueryTotal (
+          response HTTP.status200
-          if iPreferRepresentation == Full then
+            (contentTypeHeaders context ++ [contentRangeHeader])
-            response HTTP.status200
+            (LBS.fromStrict rsBody)
-              (contentTypeHeaders context ++ [contentRangeHeader])
+        else
-              (LBS.fromStrict rsBody)
+          response HTTP.status204 [contentRangeHeader] mempty
-          else
-            response HTTP.status204 [contentRangeHeader] mempty)
 
     RSPlan plan ->
       pure $ Wai.responseLBS HTTP.status200 (contentTypeHeaders context) $ LBS.fromStrict plan
@@ -499,6 +502,8 @@ handleInvoke invMethod proc context@RequestContext{..} = do
         bField
         (configDbPreparedStatements ctxConfig)
 
+  failNotSingular iAcceptMediaType resultSet
+
   case resultSet of
     RSStandard {..} -> do
       let
@@ -510,8 +515,7 @@ handleInvoke invMethod proc context@RequestContext{..} = do
             $ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal)
           else LBS.fromStrict rsBody
 
-      failNotSingular iAcceptMediaType rsQueryTotal $
+      pure $ if Proc.procReturnsVoid proc then
-        if Proc.procReturnsVoid proc then
           response HTTP.status204 [contentRange] mempty
         else
           response status
@@ -608,24 +612,20 @@ decodeGucStatus =
 -- |
 -- Fail a response if a single JSON object was requested and not exactly one
 -- 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} =
-      lift SQL.condemn
+  when (queryTotal > fromIntegral maxChanges) $ do
-      throwError $ Error.OffLimitsChangesError queryTotal maxChanges
+    lift SQL.condemn
-  else
+    throwError $ Error.OffLimitsChangesError queryTotal maxChanges
-    return response
-failChangesOffLimits _ _ response = return response
 
 shouldCount :: Maybe PreferCount -> Bool
 shouldCount preferCount =

src/PostgREST/Query/Statements.hs

@@ -22,8 +22,8 @@ import qualified Hasql.DynamicStatements.Snippet   as SQL
 import qualified Hasql.DynamicStatements.Statement as SQL
 import qualified Hasql.Statement                   as SQL
 
-import Control.Lens              ((^?))
+import Control.Lens ((^?))
-import Data.Maybe                (fromJust)
+import Data.Maybe   (fromJust)
 
 import PostgREST.DbStructure.Identifiers (FieldName)
 import PostgREST.MediaType               (MTPlanAttrs (..),