From 31fb44749e34d116f2107047d87b91b0f6e687c3 Mon Sep 17 00:00:00 2001
From: monacoremo <59358383+monacoremo@users.noreply.github.com>
Date: Mon, 26 Apr 2021 21:27:39 +0200
Subject: [PATCH] refactor failNotSingular

---
 src/PostgREST/Query.hs    | 30 +++++++++++++++---------------
 src/PostgREST/Response.hs |  2 +-
 2 files changed, 16 insertions(+), 16 deletions(-)

diff --git a/src/PostgREST/Query.hs b/src/PostgREST/Query.hs
index 1c55092044..c8be6e32de 100644
--- a/src/PostgREST/Query.hs
+++ b/src/PostgREST/Query.hs
@@ -77,8 +77,8 @@ read req bField conf@AppConfig{..} dbStructure apiRequest@ApiRequest{..} = do
         configDbPreparedStatements
 
   total <- readTotal conf apiRequest tableTotal countQuery
-  fullResult <- liftEither $ (result, total,,) <$> gucHeaders <*> gucStatus
-  failNotSingular iAcceptContentType queryTotal fullResult
+  failNotSingular iAcceptContentType queryTotal
+  liftEither $ (result, total,,) <$> gucHeaders <*> gucStatus
   where
     countQuery = QueryBuilder.readRequestToCountQuery req
 
@@ -102,14 +102,16 @@ readTotal AppConfig{..} ApiRequest{..} tableTotal countQuery =
 create :: QualifiedIdentifier -> AppConfig -> DbStructure -> ApiRequest -> ReadRequest -> MutateRequest -> DbHandler WriteQueryResult
 create identifier@QualifiedIdentifier{..} conf dbStructure apiRequest@ApiRequest{..} readReq mutReq = do
   result <- writeQuery identifier True pkCols conf dbStructure apiRequest readReq mutReq
-  failNotSingular iAcceptContentType (resQueryTotal result) result
+  failNotSingular iAcceptContentType (resQueryTotal result)
+  return result
   where
     pkCols = tablePKCols dbStructure qiSchema qiName
 
 update :: QualifiedIdentifier -> AppConfig -> DbStructure -> ApiRequest -> ReadRequest -> MutateRequest -> DbHandler WriteQueryResult
 update identifier conf dbStructure apiRequest@ApiRequest{..} readReq mutReq = do
   result <- writeQuery identifier False mempty conf dbStructure apiRequest readReq mutReq
-  failNotSingular iAcceptContentType (resQueryTotal result) result
+  failNotSingular iAcceptContentType (resQueryTotal result)
+  return result
 
 singleUpsert :: QualifiedIdentifier -> AppConfig -> DbStructure -> ApiRequest -> ReadRequest -> MutateRequest -> DbHandler WriteQueryResult
 singleUpsert identifier conf dbStructure apiRequest@ApiRequest{..} readReq mutReq= do
@@ -133,7 +135,8 @@ singleUpsert identifier conf dbStructure apiRequest@ApiRequest{..} readReq mutRe
 delete :: AppConfig -> DbStructure -> QualifiedIdentifier -> ApiRequest -> ReadRequest -> MutateRequest -> DbHandler WriteQueryResult
 delete conf dbStructure identifier apiRequest@ApiRequest{..} readReq mutReq = do
   result <- writeQuery identifier False mempty conf dbStructure apiRequest readReq mutReq
-  failNotSingular iAcceptContentType (resQueryTotal result) result
+  failNotSingular iAcceptContentType (resQueryTotal result)
+  return result
 
 invoke :: ProcDescription -> ReadRequest -> Maybe FieldName -> AppConfig -> DbStructure -> ApiRequest -> DbHandler (Statements.ProcResults, [GucHeader], Maybe HTTP.Status)
 invoke proc req bField AppConfig{..} dbStructure ApiRequest{..} = do
@@ -160,8 +163,8 @@ invoke proc req bField AppConfig{..} dbStructure ApiRequest{..} = do
         (pgVersion dbStructure)
         configDbPreparedStatements
 
-  fullResult <- liftEither $ (result,,) <$> gucHeaders <*> gucStatus
-  failNotSingular iAcceptContentType queryTotal fullResult
+  failNotSingular iAcceptContentType queryTotal
+  liftEither $ (result,,) <$> gucHeaders <*> gucStatus
   where
     returnsSingle (ApiRequest.TargetProc target _) = Proc.procReturnsSingle target
     returnsSingle _                                = False
@@ -221,14 +224,11 @@ writeQuery QualifiedIdentifier{..} isInsert pkCols AppConfig{..} dbStructure Api
 
 -- | Fail a response if a single JSON object was requested and not exactly one
 -- was found.
-failNotSingular :: ContentType -> Int64 -> a -> DbHandler a
-failNotSingular contentType queryTotal response =
-  if contentType == CTSingularJSON && queryTotal /= 1 then
-    do
-      lift SQL.condemn
-      throwError $ Error.singularityError queryTotal
-  else
-    return response
+failNotSingular :: ContentType -> Int64 -> DbHandler ()
+failNotSingular contentType queryTotal =
+  when (contentType == CTSingularJSON && queryTotal /= 1) $ do
+    lift SQL.condemn
+    throwError $ Error.singularityError queryTotal
 
 shouldCount :: Maybe PreferCount -> Bool
 shouldCount preferCount =
diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs
index ce3bc3a12f..3474d5eaa2 100644
--- a/src/PostgREST/Response.hs
+++ b/src/PostgREST/Response.hs
@@ -34,11 +34,11 @@ import PostgREST.DbStructure.Table       (Table (..))
 import PostgREST.GucHeader               (GucHeader,
                                           addHeadersIfNotIncluded,
                                           unwrapGucHeader)
+import PostgREST.Query                   (WriteQueryResult (..))
 import PostgREST.Request.ApiRequest      (ApiRequest (..),
                                           InvokeMethod (..))
 import PostgREST.Request.Preferences     (PreferCount (..),
                                           PreferRepresentation (..))
-import PostgREST.Query     (WriteQueryResult (..))
 
 import qualified PostgREST.ContentType as ContentType