Add "for" param for the vnd.pgrst.plan media type

CHANGELOG.md

@@ -38,8 +38,9 @@ This project adheres to [Semantic Versioning](http://semver.org/).
  - #2378, Support http OPTIONS method on RPC and root path - @steve-chavez
  - #2354, Allow getting the EXPLAIN plan of a request by using the `Accept: application/vnd.pgrst.plan` header - @steve-chavez
    + Only allowed if the `db-plan-enabled` config is set to true
-   + Limited to generating the plan of a json representation(`application/json`) but can be extended later to allow other representations.
+   + Can generate the plan for different media types using the `for` parameter: `Accept: application/vnd.pgrst.plan; for="application/vnd.pgrst.object"`
-   + The plan can be obtained in text(`Accept: application/vnd.pgrst.plan+text`) and json(`Accept: application/vnd.pgrst.plan+json` or `Accept: application/vnd.pgrst.plan`) format.
+   + Different options for the plan can be used with the `options` parameter: `Accept: application/vnd.pgrst.plan; options=analyze|verbose|settings|buffers|wal`
+   + The plan can be obtained in text or json by using different media type suffixes: `Accept: application/vnd.pgrst.plan+text` and `Accept: application/vnd.pgrst.plan+json`.
 
 ### Fixed
 

src/PostgREST/App.hs

@@ -73,7 +73,8 @@ import PostgREST.Error                   (Error)
 import PostgREST.GucHeader               (GucHeader,
                                           addHeadersIfNotIncluded,
                                           unwrapGucHeader)
-import PostgREST.MediaType               (MediaType (..))
+import PostgREST.MediaType               (MTPlanAttrs (..),
+                                          MediaType (..))
 import PostgREST.Query.Statements        (ResultSet (..))
 import PostgREST.Request.ApiRequest      (Action (..),
                                           ApiRequest (..),
@@ -647,11 +648,17 @@ binaryField RequestContext{..} readReq
       if length fldNames == 1 && fieldName /= Just "*" then
         return fieldName
       else
-        throwError $ Error.BinaryFieldError (iAcceptMediaType ctxApiRequest)
+        throwError $ Error.BinaryFieldError mediaType
   | otherwise =
       return Nothing
   where
-    isRawMediaType = iAcceptMediaType ctxApiRequest `elem` configRawMediaTypes ctxConfig `union` [MTOctetStream, MTTextPlain, MTTextXML]
+    mediaType = iAcceptMediaType ctxApiRequest
+    isRawMediaType = mediaType `elem` configRawMediaTypes ctxConfig `union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan mediaType
+    isRawPlan mt = case mt of
+      MTPlan (MTPlanAttrs (Just MTOctetStream) _ _) -> True
+      MTPlan (MTPlanAttrs (Just MTTextPlain) _ _)   -> True
+      MTPlan (MTPlanAttrs (Just MTTextXML) _ _)     -> True
+      _                                             -> False
 
 profileHeader :: ApiRequest -> Maybe HTTP.Header
 profileHeader ApiRequest{..} =

src/PostgREST/MediaType.hs

@@ -8,10 +8,12 @@ module PostgREST.MediaType
   , toContentType
   , toMime
   , decodeMediaType
+  , getMediaType
   ) where
 
 import qualified Data.ByteString          as BS
 import qualified Data.ByteString.Internal as BS (c2w)
+import           Data.Maybe               (fromJust)
 
 import Network.HTTP.Types.Header (Header, hContentType)
 
@@ -33,7 +35,7 @@ data MediaType
   | MTPlan MTPlanAttrs
   deriving Eq
 
-data MTPlanAttrs = MTPlanAttrs MTPlanFormat [MTPlanOption]
+data MTPlanAttrs = MTPlanAttrs (Maybe MediaType) MTPlanFormat [MTPlanOption]
 instance Eq MTPlanAttrs where
   MTPlanAttrs {} == MTPlanAttrs {} = True -- we don't care about the attributes when comparing two MTPlan media types
 
@@ -65,8 +67,10 @@ toMime MTUrlEncoded      = "application/x-www-form-urlencoded"
 toMime MTOctetStream     = "application/octet-stream"
 toMime MTAny             = "*/*"
 toMime (MTOther ct)      = ct
-toMime (MTPlan (MTPlanAttrs fmt opts)) = "application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <>
+toMime (MTPlan (MTPlanAttrs mt fmt opts)) =
-                            if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts)
+  "application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <>
+  (if isNothing mt then mempty else "; for=\"" <> toMime (fromJust mt) <> "\"") <>
+  (if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts))
 
 toMimePlanOption :: MTPlanOption -> ByteString
 toMimePlanOption PlanAnalyze  = "analyze"
@@ -101,11 +105,20 @@ decodeMediaType mt =
     _                                      -> MTAny
   where
     getPlan fmt rest =
-     let opts = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest)
+     let
-         inOpts str = str `elem` opts in
+       opts         = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest)
-     MTPlan $ MTPlanAttrs fmt $
+       inOpts str   = str `elem` opts
+       mtFor        = decodeMediaType . dropAround (== BS.c2w '"') <$> (BS.stripPrefix "for=" =<< find (BS.isPrefixOf "for=") rest)
+       dropAround p = BS.dropWhile p . BS.dropWhileEnd p in
+     MTPlan $ MTPlanAttrs mtFor fmt $
       [PlanAnalyze  | inOpts "analyze" ] ++
       [PlanVerbose  | inOpts "verbose" ] ++
       [PlanSettings | inOpts "settings"] ++
       [PlanBuffers  | inOpts "buffers" ] ++
       [PlanWAL      | inOpts "wal"     ]
+
+getMediaType :: MediaType -> MediaType
+getMediaType mt = case mt of
+  MTPlan (MTPlanAttrs (Just mType) _ _) -> mType
+  MTPlan (MTPlanAttrs Nothing _ _)      -> MTApplicationJSON
+  other                                 -> other

src/PostgREST/Query/Statements.hs

@@ -35,7 +35,8 @@ import PostgREST.GucHeader (GucHeader)
 import PostgREST.DbStructure.Identifiers (FieldName)
 import PostgREST.MediaType               (MTPlanAttrs (..),
                                           MTPlanFormat (..),
-                                          MediaType (..))
+                                          MediaType (..),
+                                          getMediaType)
 import PostgREST.Query.SqlFragment
 import PostgREST.Request.Preferences
 
@@ -63,8 +64,8 @@ data ResultSet
 
 prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType ->
                 PreferRepresentation -> [Text] -> Bool -> SQL.Statement () ResultSet
-prepareWrite selectQuery mutateQuery isInsert mediaType rep pKeys =
+prepareWrite selectQuery mutateQuery isInsert mt rep pKeys =
-  SQL.dynamicallyParameterized (mtSnippet mediaType snippet) decodeIt
+  SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
  where
   snippet =
     "WITH " <> SQL.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <>
@@ -90,9 +91,9 @@ prepareWrite selectQuery mutateQuery isInsert mediaType rep pKeys =
 
   bodyF
     | rep /= Full                       = "''"
-    | mediaType == MTTextCSV      = asCsvF
+    | getMediaType mt == MTTextCSV      = asCsvF
-    | mediaType == MTGeoJSON      = asGeoJsonF
+    | getMediaType mt == MTGeoJSON      = asGeoJsonF
-    | mediaType == MTSingularJSON = asJsonSingleF False
+    | getMediaType mt == MTSingularJSON = asJsonSingleF False
     | otherwise                         = asJsonF False
 
   selectF
@@ -101,13 +102,13 @@ prepareWrite selectQuery mutateQuery isInsert mediaType rep pKeys =
     | otherwise   = selectQuery
 
   decodeIt :: HD.Result ResultSet
-  decodeIt = case mediaType of
+  decodeIt = case mt of
     MTPlan{} -> planRow
     _        -> fromMaybe (RSStandard Nothing 0 mempty mempty (Right []) (Right Nothing)) <$> HD.rowMaybe (standardRow False)
 
 prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> Maybe FieldName -> Bool -> SQL.Statement () ResultSet
-prepareRead selectQuery countQuery countTotal mediaType binaryField =
+prepareRead selectQuery countQuery countTotal mt binaryField =
-  SQL.dynamicallyParameterized (mtSnippet mediaType snippet) decodeIt
+  SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
  where
   snippet =
     "WITH " <>
@@ -124,23 +125,23 @@ prepareRead selectQuery countQuery countTotal mediaType binaryField =
   (countCTEF, countResultF) = countF countQuery countTotal
 
   bodyF
-    | mediaType == MTTextCSV                       = asCsvF
+    | getMediaType mt == MTTextCSV                       = asCsvF
-    | mediaType == MTSingularJSON                  = asJsonSingleF False
+    | getMediaType mt == MTSingularJSON                  = asJsonSingleF False
-    | mediaType == MTGeoJSON                       = asGeoJsonF
+    | getMediaType mt == MTGeoJSON                       = asGeoJsonF
-    | isJust binaryField && mediaType == MTTextXML = asXmlF $ fromJust binaryField
+    | isJust binaryField && getMediaType mt == MTTextXML = asXmlF $ fromJust binaryField
     | isJust binaryField                                 = asBinaryF $ fromJust binaryField
     | otherwise                                          = asJsonF False
 
   decodeIt :: HD.Result ResultSet
-  decodeIt = case mediaType of
+  decodeIt = case mt of
     MTPlan{} -> planRow
     _        -> HD.singleRow $ standardRow True
 
 prepareCall :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
                MediaType -> Bool -> Maybe FieldName -> Bool ->
                SQL.Statement () ResultSet
-prepareCall returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal mediaType multObjects binaryField =
+prepareCall returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal mt multObjects binaryField =
-  SQL.dynamicallyParameterized (mtSnippet mediaType snippet) decodeIt
+  SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
   where
     snippet =
       "WITH " <> SQL.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <>
@@ -157,16 +158,16 @@ prepareCall returnsScalar returnsSingle callProcQuery selectQuery countQuery cou
     (countCTEF, countResultF) = countF countQuery countTotal
 
     bodyF
-     | mediaType == MTSingularJSON                  = asJsonSingleF returnsScalar
+     | getMediaType mt == MTSingularJSON                  = asJsonSingleF returnsScalar
-     | mediaType == MTTextCSV                       = asCsvF
+     | getMediaType mt == MTTextCSV                       = asCsvF
-     | mediaType == MTGeoJSON                       = asGeoJsonF
+     | getMediaType mt == MTGeoJSON                       = asGeoJsonF
-     | isJust binaryField && mediaType == MTTextXML = asXmlF $ fromJust binaryField
+     | isJust binaryField && getMediaType mt == MTTextXML = asXmlF $ fromJust binaryField
      | isJust binaryField                                 = asBinaryF $ fromJust binaryField
      | returnsSingle && not multObjects                   = asJsonSingleF returnsScalar
      | otherwise                                          = asJsonF returnsScalar
 
     decodeIt :: HD.Result ResultSet
-    decodeIt = case mediaType of
+    decodeIt = case mt of
       MTPlan{} -> planRow
       _        -> fromMaybe (RSStandard (Just 0) 0 mempty mempty (Right []) (Right Nothing)) <$> HD.rowMaybe (standardRow True)
 
@@ -194,7 +195,7 @@ standardRow noLocation =
 
 mtSnippet :: MediaType -> SQL.Snippet -> SQL.Snippet
 mtSnippet mediaType snippet = case mediaType of
-  MTPlan (MTPlanAttrs fmt opts) -> explainF fmt opts snippet
+  MTPlan (MTPlanAttrs _ fmt opts) -> explainF fmt opts snippet
   _                               -> snippet
 
 -- | We use rowList because when doing EXPLAIN (FORMAT TEXT), the result comes as many rows. FORMAT JSON comes as one.

src/PostgREST/Request/ApiRequest.hs

@@ -429,7 +429,7 @@ requestMediaTypes conf action path =
         ++ [MTOpenAPI | pathIsRootSpec path]
     defaultMediaTypes =
       [MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++
-      [MTPlan $ MTPlanAttrs PlanJSON mempty | configDbPlanEnabled conf]
+      [MTPlan $ MTPlanAttrs Nothing PlanJSON mempty | configDbPlanEnabled conf]
     rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML]
 
 {-|

test/spec/Feature/Query/PlanSpec.hs

@@ -125,6 +125,32 @@ spec actualPgVersion = do
         resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=verbose; charset=utf-8")
         cols `shouldBe` Just [aesonQQ| ["projects.id", "projects.name", "projects.client_id"] |]
 
+    it "outputs the plan for application/json " $ do
+      r <- request methodGet "/projects" (acceptHdrs "application/vnd.pgrst.plan+json; for=\"application/json\"; options=verbose") ""
+
+      let aggCol  = simpleBody r ^? nth 0 . key "Plan" . key "Output" . nth 2
+          resHeaders = simpleHeaders r
+
+      liftIO $ do
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=verbose; charset=utf-8")
+        aggCol `shouldBe`
+          if actualPgVersion >= pgVersion120
+            then Just [aesonQQ| "(COALESCE(json_agg(ROW(projects.id, projects.name, projects.client_id)), '[]'::json))::character varying" |]
+            else Just [aesonQQ| "(COALESCE(json_agg(ROW(pgrst_source.id, pgrst_source.name, pgrst_source.client_id)), '[]'::json))::character varying" |]
+
+    it "outputs the plan for application/vnd.pgrst.object " $ do
+      r <- request methodGet "/projects_view" (acceptHdrs "application/vnd.pgrst.plan+json; for=\"application/vnd.pgrst.object\"; options=verbose") ""
+
+      let aggCol  = simpleBody r ^? nth 0 . key "Plan" . key "Output" . nth 2
+          resHeaders = simpleHeaders r
+
+      liftIO $ do
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/vnd.pgrst.object+json\"; options=verbose; charset=utf-8")
+        aggCol `shouldBe`
+          if actualPgVersion >= pgVersion120
+            then Just [aesonQQ| "COALESCE(((json_agg(ROW(projects.id, projects.name, projects.client_id)) -> 0))::text, 'null'::text)" |]
+            else Just [aesonQQ| "COALESCE(((json_agg(ROW(pgrst_source.id, pgrst_source.name, pgrst_source.client_id)) -> 0))::text, 'null'::text)" |]
+
   describe "writes plans" $ do
     it "outputs the total cost for an insert" $ do
       r <- request methodPost "/projects"
@@ -188,6 +214,17 @@ spec actualPgVersion = do
             then Just [aesonQQ|1.3|]
             else Just [aesonQQ|1.35|]
 
+    it "outputs the plan for application/vnd.pgrst.object" $ do
+      r <- request methodDelete "/projects?id=eq.6"
+        [("Prefer", "return=representation"), ("Accept", "application/vnd.pgrst.plan+json; for=\"application/vnd.pgrst.object\"; options=verbose")] ""
+
+      let aggCol  = simpleBody r ^? nth 0 . key "Plan" . key "Output" . nth 3
+          resHeaders = simpleHeaders r
+
+      liftIO $ do
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/vnd.pgrst.object+json\"; options=verbose; charset=utf-8")
+        aggCol `shouldBe` Just [aesonQQ| "COALESCE(((json_agg(ROW(projects.id, projects.name, projects.client_id)) -> 0))::text, 'null'::text)" |]
+
   describe "function plan" $ do
     it "outputs the total cost for a function call" $ do
       r <- request methodGet "/rpc/getallprojects?id=in.(1,2,3)"
@@ -202,6 +239,17 @@ spec actualPgVersion = do
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
         totalCost `shouldBe` Just [aesonQQ|68.57|]
 
+    it "outputs the plan for text/xml" $ do
+      r <- request methodGet "/rpc/return_scalar_xml"
+        (acceptHdrs "application/vnd.pgrst.plan+json; for=\"text/xml\"; options=verbose") ""
+
+      let aggCol  = simpleBody r ^? nth 0 . key "Plan" . key "Output" . nth 2
+          resHeaders = simpleHeaders r
+
+      liftIO $ do
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"text/xml\"; options=verbose; charset=utf-8")
+        aggCol `shouldBe` Just [aesonQQ| "COALESCE(xmlagg(return_scalar_xml.pgrst_scalar), ''::xml)" |]
+
   describe "text format" $
     it "outputs the total cost for a function call" $ do
       r <- request methodGet "/projects?id=in.(1,2,3)"