no errors in Response

PostgREST · Apr 26, 2021 · cde8645 · cde8645
1 parent 912bb16
commit cde8645
Show file tree

Hide file tree

Showing 2 changed files with 32 additions and 34 deletions.
diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
@@ -31,14 +31,18 @@ import qualified PostgREST.Error      as Error
 import qualified PostgREST.Middleware as Middleware
 import qualified PostgREST.Response   as Response
 
-import PostgREST.AppState           (AppState)
-import PostgREST.Config             (AppConfig (..), LogLevel (..))
-import PostgREST.DbStructure        (DbStructure (..))
-import PostgREST.Error              (Error)
-import PostgREST.Request            (Request (..))
-import PostgREST.Request.ApiRequest (ApiRequest (..))
-import PostgREST.Version            (prettyVersion)
-import PostgREST.Workers            (connectionWorker, listener)
+import PostgREST.AppState                (AppState)
+import PostgREST.Config                  (AppConfig (..),
+                                          LogLevel (..))
+import PostgREST.DbStructure             (DbStructure (..),
+                                          tablePKCols)
+import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..))
+import PostgREST.DbStructure.Table       (Table (..))
+import PostgREST.Error                   (Error)
+import PostgREST.Request                 (Request (..))
+import PostgREST.Request.ApiRequest      (ApiRequest (..))
+import PostgREST.Version                 (prettyVersion)
+import PostgREST.Workers                 (connectionWorker, listener)
 
 import qualified PostgREST.Query   as Query
 import qualified PostgREST.Request as Request
@@ -172,8 +176,13 @@ handleRequest conf dbStructure req =
       Response.deleteResponse apiRequest
         <$> Query.delete conf dbStructure identifier apiRequest readReq mutReq
 
-    InfoRequest _ identifier ->
-      liftEither $ Response.infoResponse identifier dbStructure
+    InfoRequest _ QualifiedIdentifier{..} ->
+      maybe (throwError Error.NotFound)
+        (return . Response.infoResponse hasPK)
+        (find tableMatches $ dbTables dbStructure)
+      where
+        tableMatches Table{..} = tableName == qiName && tableSchema == qiSchema
+        hasPK = not $ null $ tablePKCols dbStructure qiSchema qiName
 
     InvokeRequest apiRequest invMethod proc readReq bField  -> do
       (results, gucHeaders, gucStatus) <- Query.invoke proc readReq bField conf dbStructure apiRequest
@@ -182,3 +191,4 @@ handleRequest conf dbStructure req =
     OpenApiRequest apiRequest headersOnly tSchema -> do
       (accessibleTables, schemaDescription, accessibleProcs) <- Query.openApi tSchema conf
       return $ Response.openApiResponse headersOnly conf dbStructure apiRequest accessibleTables schemaDescription accessibleProcs
+
diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs
@@ -20,7 +20,6 @@ import qualified Network.HTTP.Types.Status as HTTP
 import qualified Network.HTTP.Types.URI    as HTTP
 import qualified Network.Wai               as Wai
 
-import qualified PostgREST.Error            as Error
 import qualified PostgREST.OpenAPI          as OpenAPI
 import qualified PostgREST.Query.Statements as Statements
 import qualified PostgREST.RangeQuery       as RangeQuery
@@ -33,7 +32,6 @@ import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..),
                                           Schema)
 import PostgREST.DbStructure.Proc        (ProcDescription)
 import PostgREST.DbStructure.Table       (Table (..))
-import PostgREST.Error                   (Error)
 import PostgREST.GucHeader               (GucHeader,
                                           addHeadersIfNotIncluded,
                                           unwrapGucHeader)
@@ -50,9 +48,8 @@ import Protolude.Conv (toS)
 
 readResponse :: Bool -> QualifiedIdentifier -> AppConfig  -> ApiRequest -> Statements.ResultsWithCount -> Maybe Int64 -> [GucHeader] -> Maybe HTTP.Status -> Wai.Response
 readResponse headersOnly identifier AppConfig{..} apiRequest@ApiRequest{..} (_, queryTotal, _ , body, _, _) total gucHeaders gucStatus =
-  response status headers $ if headersOnly then mempty else toS body
+  gucResponse gucStatus gucHeaders status headers $ if headersOnly then mempty else toS body
   where
-    response = gucResponse gucStatus gucHeaders
     (status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange queryTotal total
     headers =
       [ contentRange
@@ -67,12 +64,12 @@ readResponse headersOnly identifier AppConfig{..} apiRequest@ApiRequest{..} (_,
 createResponse :: QualifiedIdentifier -> DbStructure -> ApiRequest -> WriteQueryResult -> Wai.Response
 createResponse QualifiedIdentifier{..} dbStructure apiRequest@ApiRequest{..} WriteQueryResult{..} =
   if iPreferRepresentation == Full then
-    response HTTP.status201 (headers ++ contentTypeHeaders apiRequest) (toS resBody)
+    response (headers ++ contentTypeHeaders apiRequest) (toS resBody)
   else
-    response HTTP.status201 headers mempty
+    response headers mempty
   where
     pkCols = tablePKCols dbStructure qiSchema qiName
-    response = gucResponse resGucStatus resGucHeaders
+    response = gucResponse resGucStatus resGucHeaders HTTP.status201
     headers =
       catMaybes
         [ if null resFields then
@@ -95,11 +92,11 @@ createResponse QualifiedIdentifier{..} dbStructure apiRequest@ApiRequest{..} Wri
 updateResponse :: ApiRequest -> WriteQueryResult -> Wai.Response
 updateResponse apiRequest@ApiRequest{..} WriteQueryResult{..} =
   if fullRepr then
-    response status (contentTypeHeaders apiRequest ++ [contentRangeHeader]) (toS resBody)
+    response (contentTypeHeaders apiRequest ++ [contentRangeHeader]) (toS resBody)
   else
-    response status [contentRangeHeader] mempty
+    response [contentRangeHeader] mempty
   where
-    response = gucResponse resGucStatus resGucHeaders
+    response = gucResponse resGucStatus resGucHeaders status
     fullRepr = iPreferRepresentation == Full
     updateIsNoOp = Set.null iColumns
     status
@@ -133,29 +130,20 @@ deleteResponse apiRequest@ApiRequest{..} WriteQueryResult{..} =
       RangeQuery.contentRangeH 1 0 $
         if shouldCount iPreferCount then Just resQueryTotal else Nothing
 
-infoResponse :: QualifiedIdentifier -> DbStructure -> Either Error Wai.Response
-infoResponse identifier dbStructure =
-  case find tableMatches $ dbTables dbStructure of
-    Just table ->
-      return $ Wai.responseLBS HTTP.status200 [allOrigins, allowH table] mempty
-    Nothing ->
-      throwError Error.NotFound
+infoResponse :: Bool -> Table -> Wai.Response
+infoResponse hasPrimaryKey table =
+  Wai.responseLBS HTTP.status200 [allOrigins, allowH] mempty
   where
     allOrigins = ("Access-Control-Allow-Origin", "*")
-    allowH table =
+    allowH =
       ( HTTP.hAllow
       , BS8.intercalate "," $
           ["OPTIONS,GET,HEAD"]
           ++ ["POST" | tableInsertable table]
-          ++ ["PUT" | tableInsertable table && tableUpdatable table && hasPK]
+          ++ ["PUT" | tableInsertable table && tableUpdatable table && hasPrimaryKey]
           ++ ["PATCH" | tableUpdatable table]
           ++ ["DELETE" | tableDeletable table]
       )
-    tableMatches table =
-      tableName table == qiName identifier
-      && tableSchema table == qiSchema identifier
-    hasPK =
-      not $ null $ tablePKCols dbStructure (qiSchema identifier) (qiName identifier)
 
 invokeResponse :: InvokeMethod -> ApiRequest -> Statements.ProcResults -> [GucHeader] -> Maybe HTTP.Status -> Wai.Response
 invokeResponse invMethod apiRequest@ApiRequest{..} (tableTotal, queryTotal, body, _, _) gucHeaders gucStatus =