diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 7921c0b0b9e..9f014c00383 100644 --- 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 index 5e85a02ac51..4f8100584e2 100644 --- 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