From e861dc076faee8a5bb952f9ad630e846ab1ded19 Mon Sep 17 00:00:00 2001
From: steve-chavez <stevechavezast@gmail.com>
Date: Fri, 16 Jun 2023 16:42:37 -0500
Subject: [PATCH] refactor: clarify content negotiation

---
 src/PostgREST/ApiRequest.hs | 40 ++++++++++++++++---------------------
 1 file changed, 17 insertions(+), 23 deletions(-)

diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs
index 6d36e2ac971..0ea72c6f7b5 100644
--- a/src/PostgREST/ApiRequest.hs
+++ b/src/PostgREST/ApiRequest.hs
@@ -207,7 +207,7 @@ getAction PathInfo{pathIsProc, pathIsDefSpec} method =
 
 getMediaTypes :: AppConfig -> RequestHeaders -> Action -> PathInfo -> Either ApiRequestError (MediaType, MediaType)
 getMediaTypes conf hdrs action path = do
-   acceptMediaType <- findAcceptMediaType conf action path accepts
+   acceptMediaType <- negotiateContent conf action path accepts
    pure (acceptMediaType, contentMediaType)
   where
     accepts = maybe [MTAny] (map MediaType.decodeMediaType . parseHttpAccept) $ lookupHeader "accept"
@@ -299,19 +299,6 @@ getPayload reqBody contentMediaType QueryParams{qsColumns} action PathInfo{pathI
       ActionInvoke InvPost        -> qsColumns
       _                           -> Nothing
 
-{-|
-  Find the best match from a list of media types accepted by the
-  client in order of decreasing preference and a list of types
-  producible by the server.  If there is no match but the client
-  accepts */* then return the top server pick.
--}
-mutuallyAgreeable :: [MediaType] -> [MediaType] -> Maybe MediaType
-mutuallyAgreeable sProduces cAccepts =
-  let exact = listToMaybe $ L.intersect cAccepts sProduces in
-  if isNothing exact && MTAny `elem` cAccepts
-     then listToMaybe sProduces
-     else exact
-
 type CsvData = V.Vector (M.Map Text LBS.ByteString)
 
 {-|
@@ -361,20 +348,27 @@ payloadAttributes raw json =
   where
     emptyPJArray = ProcessedJSON (JSON.encode emptyArray) S.empty
 
-findAcceptMediaType :: AppConfig -> Action -> PathInfo -> [MediaType] -> Either ApiRequestError MediaType
-findAcceptMediaType conf action path accepts =
-  case mutuallyAgreeable (requestMediaTypes conf action path) accepts of
-    Just ct ->
-      Right ct
+
+-- | Do content negotiation. i.e. choose a media type based on the intersection of accepted/produced media types.
+negotiateContent :: AppConfig -> Action -> PathInfo -> [MediaType] -> Either ApiRequestError MediaType
+negotiateContent conf action path accepts =
+  case firstAcceptedPick of
+    Just MTAny ->
+      Right MTApplicationJSON -- by default(for */*) we respond with json
+    Just mt ->
+      Right mt
     Nothing ->
       Left . MediaTypeError $ map MediaType.toMime accepts
+  where
+    -- if there are multiple accepted media types, pick the first
+    firstAcceptedPick = listToMaybe $ L.intersect accepts $ producedMediaTypes conf action path
 
-requestMediaTypes :: AppConfig -> Action -> PathInfo -> [MediaType]
-requestMediaTypes conf action path =
+producedMediaTypes :: AppConfig -> Action -> PathInfo -> [MediaType]
+producedMediaTypes conf action path =
   case action of
     ActionRead _    -> defaultMediaTypes ++ rawMediaTypes
     ActionInvoke _  -> invokeMediaTypes
-    ActionInspect _ -> [MTOpenAPI, MTApplicationJSON]
+    ActionInspect _ -> [MTOpenAPI, MTApplicationJSON, MTAny]
     ActionInfo      -> defaultMediaTypes
     ActionMutate _  -> defaultMediaTypes
   where
@@ -384,5 +378,5 @@ requestMediaTypes conf action path =
         ++ [MTOpenAPI | pathIsRootSpec path]
     defaultMediaTypes =
       [MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++
-      [MTPlan $ MTPlanAttrs Nothing PlanJSON mempty | configDbPlanEnabled conf]
+      [MTPlan $ MTPlanAttrs Nothing PlanJSON mempty | configDbPlanEnabled conf] ++ [MTAny]
     rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML]