more tweaks

PostgREST · Feb 1, 2021 · 207e91c · 207e91c
1 parent 4c9778d
commit 207e91c
Showing 1 changed file with 53 additions and 55 deletions.
diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
@@ -168,48 +168,48 @@ handleRequest context@(RequestContext _ dbStructure ApiRequest{..} _) =
 
 handleRead :: Bool -> QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
 handleRead headersOnly identifier context@RequestContext{..} = do
-    req <- readRequest identifier context
-    bField <- binaryField context req
-
-    let
-      ApiRequest{..} = ctxApiRequest
-      AppConfig{..} = ctxConfig
-      countQuery = QueryBuilder.readRequestToCountQuery req
+  req <- readRequest identifier context
+  bField <- binaryField context req
 
-    (tableTotal, queryTotal, _ , body, gucHeaders, gucStatus) <-
-      lift . SQL.statement mempty $
-        Statements.createReadStatement
-          (QueryBuilder.readRequestToQuery req)
-          ( if iPreferCount == Just Types.EstimatedCount then
-              -- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
-              QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows)
-            else
-              countQuery
-          )
-          (ctxContentType == Types.CTSingularJSON)
-          (shouldCount iPreferCount)
-          (ctxContentType == Types.CTTextCSV)
-          bField
-          (Types.pgVersion ctxDbStructure)
-          configDbPreparedStatements
+  let
+    ApiRequest{..} = ctxApiRequest
+    AppConfig{..} = ctxConfig
+    countQuery = QueryBuilder.readRequestToCountQuery req
 
-    total <- readTotal ctxConfig ctxApiRequest tableTotal countQuery
-    response <- liftEither $ gucResponse <$> gucStatus <*> gucHeaders
+  (tableTotal, queryTotal, _ , body, gucHeaders, gucStatus) <-
+    lift . SQL.statement mempty $
+      Statements.createReadStatement
+        (QueryBuilder.readRequestToQuery req)
+        ( if iPreferCount == Just Types.EstimatedCount then
+            -- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
+            QueryBuilder.limitedQuery countQuery ((+ 1) <$> configDbMaxRows)
+          else
+            countQuery
+        )
+        (ctxContentType == Types.CTSingularJSON)
+        (shouldCount iPreferCount)
+        (ctxContentType == Types.CTTextCSV)
+        bField
+        (Types.pgVersion ctxDbStructure)
+        configDbPreparedStatements
 
-    let
-      (status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange queryTotal total
-      headers =
-        [ contentRange
-        , ( "Content-Location"
-          , "/"
-              <> toS (Types.qiName identifier)
-              <> if BS8.null iCanonicalQS then mempty else "?" <> toS iCanonicalQS
-          )
-        ]
-        ++ contentTypeHeaders context
+  total <- readTotal ctxConfig ctxApiRequest tableTotal countQuery
+  response <- liftEither $ gucResponse <$> gucStatus <*> gucHeaders
 
-    failNotSingular ctxContentType queryTotal . response status headers $
-      if headersOnly then mempty else toS body
+  let
+    (status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange queryTotal total
+    headers =
+      [ contentRange
+      , ( "Content-Location"
+        , "/"
+            <> toS (Types.qiName identifier)
+            <> if BS8.null iCanonicalQS then mempty else "?" <> toS iCanonicalQS
+        )
+      ]
+      ++ contentTypeHeaders context
+
+  failNotSingular ctxContentType queryTotal . response status headers $
+    if headersOnly then mempty else toS body
 
 readTotal :: AppConfig -> ApiRequest -> Maybe Int64 -> SQL.Snippet -> DbHandler (Maybe Int64)
 readTotal AppConfig{..} ApiRequest{..} tableTotal countQuery =
@@ -312,19 +312,19 @@ handleSingleUpsert identifier context@(RequestContext _ _ ApiRequest{..} _) = do
 
 handleDelete :: QualifiedIdentifier -> RequestContext -> DbHandler Wai.Response
 handleDelete identifier context@(RequestContext _ _ ApiRequest{..} contentType) = do
-  result <- writeQuery identifier False mempty context
+  CreateResult{..} <- writeQuery identifier False mempty context
 
   let
-    response = gucResponse (rGucStatus result) (rGucHeaders result)
+    response = gucResponse rGucStatus rGucHeaders
     contentRangeHeader =
       RangeQuery.contentRangeH 1 0 $
-        if shouldCount iPreferCount then Just (rQueryTotal result) else Nothing
+        if shouldCount iPreferCount then Just rQueryTotal else Nothing
 
-  failNotSingular contentType (rQueryTotal result) $
+  failNotSingular contentType rQueryTotal $
     if iPreferRepresentation == Types.Full then
       response HTTP.status200
         (contentTypeHeaders context ++ [contentRangeHeader])
-        (toS $ rBody result)
+        (toS rBody)
     else
       response HTTP.status204 [contentRangeHeader] mempty
 
@@ -333,7 +333,6 @@ handleInfo identifier dbStructure =
   case find tableMatches $ Types.dbTables dbStructure of
     Just table ->
       return $ Wai.responseLBS HTTP.status200 [allOrigins, allowH table] mempty
-
     Nothing ->
       throwError Error.NotFound
   where
@@ -473,8 +472,8 @@ gucResponse
   -> LBS.ByteString
   -> Wai.Response
 gucResponse gucStatus gucHeaders status headers =
-  Wai.responseLBS (fromMaybe status gucStatus)
-    (Types.addHeadersIfNotIncluded headers (map Types.unwrapGucHeader gucHeaders))
+  Wai.responseLBS (fromMaybe status gucStatus) $
+    Types.addHeadersIfNotIncluded headers (map Types.unwrapGucHeader gucHeaders)
 
 -- |
 -- Fail a response if a single JSON object was requested and not exactly one
@@ -496,17 +495,16 @@ returnsScalar :: ApiRequest.Target -> Bool
 returnsScalar (TargetProc proc _) = Types.procReturnsScalar proc
 returnsScalar _                   = False
 
-readRequest :: Monad m =>
-  QualifiedIdentifier -> RequestContext -> Handler m Types.ReadRequest
+readRequest :: Monad m => QualifiedIdentifier -> RequestContext -> Handler m Types.ReadRequest
 readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure apiRequest _) =
   liftEither $
     ReqBuilder.readRequest qiSchema qiName configDbMaxRows
       (Types.dbRelations dbStructure)
       apiRequest
 
 contentTypeHeaders :: RequestContext -> [HTTP.Header]
-contentTypeHeaders (RequestContext _ _ apiRequest contentType) =
-  Types.toHeader contentType : maybeToList (profileHeader apiRequest)
+contentTypeHeaders RequestContext{..} =
+  Types.toHeader ctxContentType : maybeToList (profileHeader ctxApiRequest)
 
 requestContentTypes :: AppConfig -> ApiRequest -> [ContentType]
 requestContentTypes conf ApiRequest{..} =
@@ -515,7 +513,7 @@ requestContentTypes conf ApiRequest{..} =
     ActionInvoke _  -> invokeContentTypes
     ActionInspect _ -> [Types.CTOpenAPI, Types.CTApplicationJSON]
     ActionInfo      -> [Types.CTTextCSV]
-    _               ->    defaultContentTypes
+    _               -> defaultContentTypes
   where
     invokeContentTypes =
       defaultContentTypes
@@ -529,18 +527,18 @@ requestContentTypes conf ApiRequest{..} =
 -- rawContentTypes and that`?select=...` contains only one field other than `*`
 binaryField :: Monad m =>
   RequestContext -> ReadRequest -> Handler m (Maybe Types.FieldName)
-binaryField (RequestContext conf _ apiRequest contentType) readReq
-  | returnsScalar (iTarget apiRequest) && contentType `elem` rawContentTypes conf =
+binaryField RequestContext{..} readReq
+  | returnsScalar (iTarget ctxApiRequest) && ctxContentType `elem` rawContentTypes ctxConfig =
       return $ Just "pgrst_scalar"
-  | contentType `elem` rawContentTypes conf =
+  | ctxContentType `elem` rawContentTypes ctxConfig =
       let
         fldNames = Types.fstFieldNames readReq
         fieldName = headMay fldNames
       in
       if length fldNames == 1 && fieldName /= Just "*" then
         return fieldName
       else
-        throwError $ Error.BinaryFieldError contentType
+        throwError $ Error.BinaryFieldError ctxContentType
   | otherwise =
       return Nothing