From f8e8e36c4a827087799491d502f20c95247d3410 Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Tue, 20 Jun 2023 16:45:36 -0500 Subject: [PATCH] refactor: stricter plan media type --- src/PostgREST/ApiRequest.hs | 7 ++-- src/PostgREST/MediaType.hs | 52 +++++++++++++++-------------- src/PostgREST/Plan.hs | 8 ++--- src/PostgREST/Query/SqlFragment.hs | 7 ++-- src/PostgREST/Query/Statements.hs | 2 +- test/spec/Feature/Query/PlanSpec.hs | 28 ++++++++-------- 6 files changed, 53 insertions(+), 51 deletions(-) diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index 3bc0231e06..87858688b3 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -51,7 +51,8 @@ import PostgREST.ApiRequest.Types (ApiRequestError (..), RangeError (..)) import PostgREST.Config (AppConfig (..), OpenAPIMode (..)) -import PostgREST.MediaType (MediaType (..)) +import PostgREST.MediaType (MTPlanFormat (..), + MediaType (..)) import PostgREST.RangeQuery (NonnegRange, allRange, convertToLimitZeroRange, hasLimitZero, @@ -363,9 +364,9 @@ producedMediaTypes conf action path = case action of ActionRead _ -> defaultMediaTypes ++ rawMediaTypes ActionInvoke _ -> invokeMediaTypes - ActionInspect _ -> [MTOpenAPI, MTApplicationJSON, MTAny] ActionInfo -> defaultMediaTypes ActionMutate _ -> defaultMediaTypes + ActionInspect _ -> [MTOpenAPI, MTApplicationJSON, MTAny] where invokeMediaTypes = defaultMediaTypes @@ -373,5 +374,5 @@ producedMediaTypes conf action path = ++ [MTOpenAPI | pathIsRootSpec path] defaultMediaTypes = [MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++ - [MTPlan Nothing Nothing mempty | configDbPlanEnabled conf] ++ [MTAny] + [MTPlan MTApplicationJSON PlanText mempty | configDbPlanEnabled conf] ++ [MTAny] rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML] diff --git a/src/PostgREST/MediaType.hs b/src/PostgREST/MediaType.hs index 1704b75890..0b1fbef956 100644 --- a/src/PostgREST/MediaType.hs +++ b/src/PostgREST/MediaType.hs @@ -12,7 +12,6 @@ module PostgREST.MediaType 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) @@ -39,7 +38,7 @@ data MediaType | MTOctetStream | MTAny | MTOther ByteString - | MTPlan (Maybe MediaType) (Maybe MTPlanFormat) [MTPlanOption] + | MTPlan MediaType MTPlanFormat [MTPlanOption] instance Eq MediaType where MTApplicationJSON == MTApplicationJSON = True MTSingularJSON == MTSingularJSON = True @@ -84,8 +83,8 @@ toMime MTOctetStream = "application/octet-stream" toMime MTAny = "*/*" toMime (MTOther ct) = ct toMime (MTPlan mt fmt opts) = - "application/vnd.pgrst.plan" <> maybe mempty (\x -> "+" <> toMimePlanFormat x) fmt <> - (if isNothing mt then mempty else "; for=\"" <> toMime (fromJust mt) <> "\"") <> + "application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <> + ("; for=\"" <> toMime mt <> "\"") <> (if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts)) toMimePlanOption :: MTPlanOption -> ByteString @@ -105,13 +104,13 @@ toMimePlanFormat PlanText = "text" -- MTApplicationJSON -- -- >>> decodeMediaType "application/vnd.pgrst.plan;" --- MTPlan Nothing Nothing [] +-- MTPlan MTApplicationJSON PlanText [] -- -- >>> decodeMediaType "application/vnd.pgrst.plan;for=\"application/json\"" --- MTPlan (Just MTApplicationJSON) Nothing [] +-- MTPlan MTApplicationJSON PlanText [] -- --- >>> decodeMediaType "application/vnd.pgrst.plan+text;for=\"text/csv\"" --- MTPlan (Just MTTextCSV) (Just PlanText) [] +-- >>> decodeMediaType "application/vnd.pgrst.plan+json;for=\"text/csv\"" +-- MTPlan MTTextCSV PlanJSON [] decodeMediaType :: BS.ByteString -> MediaType decodeMediaType mt = case BS.split (BS.c2w ';') mt of @@ -125,28 +124,31 @@ decodeMediaType mt = "application/vnd.pgrst.object":_ -> MTSingularJSON "application/x-www-form-urlencoded":_ -> MTUrlEncoded "application/octet-stream":_ -> MTOctetStream - "application/vnd.pgrst.plan":rest -> getPlan Nothing rest - "application/vnd.pgrst.plan+text":rest -> getPlan (Just PlanText) rest - "application/vnd.pgrst.plan+json":rest -> getPlan (Just PlanJSON) rest + "application/vnd.pgrst.plan":rest -> getPlan PlanText rest + "application/vnd.pgrst.plan+text":rest -> getPlan PlanText rest + "application/vnd.pgrst.plan+json":rest -> getPlan PlanJSON rest "*/*":_ -> MTAny other:_ -> MTOther other _ -> MTAny where getPlan fmt rest = - let - opts = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest) - 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 mtFor fmt $ - [PlanAnalyze | inOpts "analyze" ] ++ - [PlanVerbose | inOpts "verbose" ] ++ - [PlanSettings | inOpts "settings"] ++ - [PlanBuffers | inOpts "buffers" ] ++ - [PlanWAL | inOpts "wal" ] + let + opts = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest) + inOpts str = str `elem` opts + dropAround p = BS.dropWhile p . BS.dropWhileEnd p + mtFor = fromMaybe MTApplicationJSON $ do + foundFor <- find (BS.isPrefixOf "for=") rest + strippedFor <- BS.stripPrefix "for=" foundFor + pure . decodeMediaType $ dropAround (== BS.c2w '"') strippedFor + in + MTPlan 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 (Just mType) _ _ -> mType - MTPlan Nothing _ _ -> MTApplicationJSON - other -> other + MTPlan mType _ _ -> mType + other -> other diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index b6d9abe070..9e802c916a 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -633,10 +633,10 @@ binaryField AppConfig{configRawMediaTypes} acceptMediaType proc rpTree where isRawMediaType = acceptMediaType `elem` configRawMediaTypes `L.union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan acceptMediaType isRawPlan mt = case mt of - MTPlan (Just MTOctetStream) _ _ -> True - MTPlan (Just MTTextPlain) _ _ -> True - MTPlan (Just MTTextXML) _ _ -> True - _ -> False + MTPlan MTOctetStream _ _ -> True + MTPlan MTTextPlain _ _ -> True + MTPlan MTTextXML _ _ -> True + _ -> False fstFieldName :: ReadPlanTree -> Maybe FieldName fstFieldName (Node ReadPlan{select=(("*", []), _, _):_} []) = Nothing diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index ea150ec428..3834eec229 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -431,7 +431,7 @@ intercalateSnippet :: ByteString -> [SQL.Snippet] -> SQL.Snippet intercalateSnippet _ [] = mempty intercalateSnippet frag snippets = foldr1 (\a b -> a <> SQL.sql frag <> b) snippets -explainF :: Maybe MTPlanFormat -> [MTPlanOption] -> SQL.Snippet -> SQL.Snippet +explainF :: MTPlanFormat -> [MTPlanOption] -> SQL.Snippet -> SQL.Snippet explainF fmt opts snip = "EXPLAIN (" <> SQL.sql (BS.intercalate ", " (fmtPlanFmt fmt : (fmtPlanOpt <$> opts))) <> @@ -444,9 +444,8 @@ explainF fmt opts snip = fmtPlanOpt PlanBuffers = "BUFFERS" fmtPlanOpt PlanWAL = "WAL" - fmtPlanFmt Nothing = "FORMAT TEXT" - fmtPlanFmt (Just PlanJSON) = "FORMAT JSON" - fmtPlanFmt (Just PlanText) = "FORMAT TEXT" + fmtPlanFmt PlanText = "FORMAT TEXT" + fmtPlanFmt PlanJSON = "FORMAT JSON" -- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL. setConfigLocal :: ByteString -> (ByteString, ByteString) -> SQL.Snippet diff --git a/src/PostgREST/Query/Statements.hs b/src/PostgREST/Query/Statements.hs index 03fff7feed..24840f46c7 100644 --- a/src/PostgREST/Query/Statements.hs +++ b/src/PostgREST/Query/Statements.hs @@ -167,7 +167,7 @@ preparePlanRows :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64) preparePlanRows countQuery = SQL.dynamicallyParameterized snippet decodeIt where - snippet = explainF (Just PlanJSON) mempty countQuery + snippet = explainF PlanJSON mempty countQuery decodeIt :: HD.Result (Maybe Int64) decodeIt = let row = HD.singleRow $ column HD.bytea in diff --git a/test/spec/Feature/Query/PlanSpec.hs b/test/spec/Feature/Query/PlanSpec.hs index e88dec5148..8479282ec1 100644 --- a/test/spec/Feature/Query/PlanSpec.hs +++ b/test/spec/Feature/Query/PlanSpec.hs @@ -33,7 +33,7 @@ spec actualPgVersion = do resStatus = simpleStatus r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8") resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } totalCost `shouldBe` if actualPgVersion > pgVersion120 @@ -49,7 +49,7 @@ spec actualPgVersion = do resStatus = simpleStatus r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8") resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } totalCost `shouldBe` if actualPgVersion > pgVersion120 @@ -65,7 +65,7 @@ spec actualPgVersion = do resHeaders = simpleHeaders r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=buffers; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=buffers; charset=utf-8") resBody `shouldSatisfy` (\t -> T.isInfixOf "Shared Hit Blocks" (decodeUtf8 $ BS.toStrict t)) else do -- analyze is required for buffers on pg < 13 @@ -75,7 +75,7 @@ spec actualPgVersion = do resHeaders = simpleHeaders r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=analyze|buffers; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=analyze|buffers; charset=utf-8") blocks `shouldBe` Just [aesonQQ| 1.0 |] when (actualPgVersion >= pgVersion120) $ @@ -86,7 +86,7 @@ spec actualPgVersion = do resHeaders = simpleHeaders r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=settings; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=settings; charset=utf-8") searchPath `shouldBe` Just [aesonQQ| { @@ -102,7 +102,7 @@ spec actualPgVersion = do resHeaders = simpleHeaders r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=analyze|wal; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=analyze|wal; charset=utf-8") walRecords `shouldBe` Just [aesonQQ|0|] it "outputs columns info when using the verbose option" $ do @@ -112,7 +112,7 @@ spec actualPgVersion = do resHeaders = simpleHeaders r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; options=verbose; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/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 @@ -151,7 +151,7 @@ spec actualPgVersion = do resStatus = simpleStatus r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8") resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } totalCost `shouldBe` 3.27 @@ -164,7 +164,7 @@ spec actualPgVersion = do resStatus = simpleStatus r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8") resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } totalCost `shouldBe` 12.45 @@ -177,7 +177,7 @@ spec actualPgVersion = do resStatus = simpleStatus r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8") resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } totalCost `shouldBe` 15.68 @@ -191,7 +191,7 @@ spec actualPgVersion = do resStatus = simpleStatus r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8") resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } totalCost `shouldBe` 1.29 @@ -216,7 +216,7 @@ spec actualPgVersion = do resStatus = simpleStatus r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; charset=utf-8") resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } totalCost `shouldBe` 68.56 @@ -241,7 +241,7 @@ spec actualPgVersion = do resStatus = simpleStatus r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+text; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+text; for=\"application/json\"; charset=utf-8") resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } resBody `shouldSatisfy` (\t -> LBS.take 9 t == "Aggregate") @@ -254,7 +254,7 @@ spec actualPgVersion = do resStatus = simpleStatus r liftIO $ do - resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan; charset=utf-8") + resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+text; for=\"application/json\"; charset=utf-8") resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } resBody `shouldSatisfy` (\t -> LBS.take 9 t == "Aggregate")