refactor: done making Response pure

PostgREST · Sep 26, 2023 · f79b359 · f79b359
1 parent 3c11c93
commit f79b359
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 12 deletions.
diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
@@ -211,15 +211,18 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A
       pgrst <- liftEither $ Response.openApiResponse (T.decodeUtf8 prettyVersion, docsVersion) headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile
       return $ pgrstResponse pgrst
 
-    (ActionInfo, TargetIdent identifier) ->
-      return $ Response.infoIdentResponse identifier sCache
+    (ActionInfo, TargetIdent identifier) -> do
+      pgrst <- liftEither $ Response.infoIdentResponse identifier sCache
+      return $ pgrstResponse pgrst
 
     (ActionInfo, TargetProc identifier _) -> do
       cPlan <- liftEither $ Plan.callReadPlan identifier conf sCache apiReq ApiRequest.InvHead
-      return $ Response.infoProcResponse (Plan.crProc cPlan)
+      pgrst <- liftEither $ Response.infoProcResponse (Plan.crProc cPlan)
+      return $ pgrstResponse pgrst
 
-    (ActionInfo, TargetDefaultSpec _) ->
-      return Response.infoRootResponse
+    (ActionInfo, TargetDefaultSpec _) -> do
+      pgrst <- liftEither Response.infoRootResponse
+      return $ pgrstResponse pgrst
 
     _ ->
       -- This is unreachable as the ApiRequest.hs rejects it before

diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs
@@ -214,11 +214,11 @@ deleteResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Pre
   RSPlan plan ->
     Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
 
-infoIdentResponse :: QualifiedIdentifier -> SchemaCache -> Wai.Response
-infoIdentResponse identifier sCache =
+infoIdentResponse :: QualifiedIdentifier -> SchemaCache -> Either Error.Error PgrstResponse
+infoIdentResponse identifier sCache = do
   case HM.lookup identifier (dbTables sCache) of
     Just tbl -> respondInfo $ allowH tbl
-    Nothing  -> Error.errorResponseFor $ Error.ApiRequestError ApiRequestTypes.NotFound
+    Nothing  -> Left $ Error.ApiRequestError ApiRequestTypes.NotFound
   where
     allowH table =
       let hasPK = not . null $ tablePKCols table in
@@ -229,17 +229,17 @@ infoIdentResponse identifier sCache =
           ["PATCH" | tableUpdatable table] ++
           ["DELETE" | tableDeletable table]
 
-infoProcResponse :: Routine -> Wai.Response
+infoProcResponse :: Routine -> Either Error.Error PgrstResponse
 infoProcResponse proc | pdVolatility proc == Volatile = respondInfo "OPTIONS,POST"
                       | otherwise                     = respondInfo "OPTIONS,GET,HEAD,POST"
 
-infoRootResponse :: Wai.Response
+infoRootResponse :: Either Error.Error PgrstResponse
 infoRootResponse = respondInfo "OPTIONS,GET,HEAD"
 
-respondInfo :: ByteString -> Wai.Response
+respondInfo :: ByteString -> Either Error.Error PgrstResponse
 respondInfo allowHeader =
   let allOrigins = ("Access-Control-Allow-Origin", "*") in
-  Wai.responseLBS HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty
+  Right $ PgrstResponse HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty
 
 invokeResponse :: CallReadPlan -> InvokeMethod -> Routine -> ApiRequest -> ResultSet -> Maybe ServerTimingParams -> Either Error.Error PgrstResponse
 invokeResponse CallReadPlan{crMedia} invMethod proc ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet serverTimingParams = case resultSet of