refactor: stricter plan media type

This commit is contained in:
steve-chavez
2023-06-20 19:12:17 -05:00
committed by Steve Chavez
parent c1a8661ab3
commit 856d450775
6 changed files with 53 additions and 51 deletions
+4 -3
View File
@@ -51,7 +51,8 @@ import PostgREST.ApiRequest.Types (ApiRequestError (..),
RangeError (..)) RangeError (..))
import PostgREST.Config (AppConfig (..), import PostgREST.Config (AppConfig (..),
OpenAPIMode (..)) OpenAPIMode (..))
import PostgREST.MediaType (MediaType (..)) import PostgREST.MediaType (MTPlanFormat (..),
MediaType (..))
import PostgREST.RangeQuery (NonnegRange, allRange, import PostgREST.RangeQuery (NonnegRange, allRange,
convertToLimitZeroRange, convertToLimitZeroRange,
hasLimitZero, hasLimitZero,
@@ -363,9 +364,9 @@ producedMediaTypes conf action path =
case action of case action of
ActionRead _ -> defaultMediaTypes ++ rawMediaTypes ActionRead _ -> defaultMediaTypes ++ rawMediaTypes
ActionInvoke _ -> invokeMediaTypes ActionInvoke _ -> invokeMediaTypes
ActionInspect _ -> [MTOpenAPI, MTApplicationJSON, MTAny]
ActionInfo -> defaultMediaTypes ActionInfo -> defaultMediaTypes
ActionMutate _ -> defaultMediaTypes ActionMutate _ -> defaultMediaTypes
ActionInspect _ -> [MTOpenAPI, MTApplicationJSON, MTAny]
where where
invokeMediaTypes = invokeMediaTypes =
defaultMediaTypes defaultMediaTypes
@@ -373,5 +374,5 @@ producedMediaTypes conf action path =
++ [MTOpenAPI | pathIsRootSpec path] ++ [MTOpenAPI | pathIsRootSpec path]
defaultMediaTypes = defaultMediaTypes =
[MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++ [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] rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML]
+27 -25
View File
@@ -12,7 +12,6 @@ module PostgREST.MediaType
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS (c2w) import qualified Data.ByteString.Internal as BS (c2w)
import Data.Maybe (fromJust)
import Network.HTTP.Types.Header (Header, hContentType) import Network.HTTP.Types.Header (Header, hContentType)
@@ -39,7 +38,7 @@ data MediaType
| MTOctetStream | MTOctetStream
| MTAny | MTAny
| MTOther ByteString | MTOther ByteString
| MTPlan (Maybe MediaType) (Maybe MTPlanFormat) [MTPlanOption] | MTPlan MediaType MTPlanFormat [MTPlanOption]
instance Eq MediaType where instance Eq MediaType where
MTApplicationJSON == MTApplicationJSON = True MTApplicationJSON == MTApplicationJSON = True
MTSingularJSON == MTSingularJSON = True MTSingularJSON == MTSingularJSON = True
@@ -84,8 +83,8 @@ toMime MTOctetStream = "application/octet-stream"
toMime MTAny = "*/*" toMime MTAny = "*/*"
toMime (MTOther ct) = ct toMime (MTOther ct) = ct
toMime (MTPlan mt fmt opts) = toMime (MTPlan mt fmt opts) =
"application/vnd.pgrst.plan" <> maybe mempty (\x -> "+" <> toMimePlanFormat x) fmt <> "application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <>
(if isNothing mt then mempty else "; for=\"" <> toMime (fromJust mt) <> "\"") <> ("; for=\"" <> toMime mt <> "\"") <>
(if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts)) (if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts))
toMimePlanOption :: MTPlanOption -> ByteString toMimePlanOption :: MTPlanOption -> ByteString
@@ -105,13 +104,13 @@ toMimePlanFormat PlanText = "text"
-- MTApplicationJSON -- MTApplicationJSON
-- --
-- >>> decodeMediaType "application/vnd.pgrst.plan;" -- >>> decodeMediaType "application/vnd.pgrst.plan;"
-- MTPlan Nothing Nothing [] -- MTPlan MTApplicationJSON PlanText []
-- --
-- >>> decodeMediaType "application/vnd.pgrst.plan;for=\"application/json\"" -- >>> decodeMediaType "application/vnd.pgrst.plan;for=\"application/json\""
-- MTPlan (Just MTApplicationJSON) Nothing [] -- MTPlan MTApplicationJSON PlanText []
-- --
-- >>> decodeMediaType "application/vnd.pgrst.plan+text;for=\"text/csv\"" -- >>> decodeMediaType "application/vnd.pgrst.plan+json;for=\"text/csv\""
-- MTPlan (Just MTTextCSV) (Just PlanText) [] -- MTPlan MTTextCSV PlanJSON []
decodeMediaType :: BS.ByteString -> MediaType decodeMediaType :: BS.ByteString -> MediaType
decodeMediaType mt = decodeMediaType mt =
case BS.split (BS.c2w ';') mt of case BS.split (BS.c2w ';') mt of
@@ -125,28 +124,31 @@ decodeMediaType mt =
"application/vnd.pgrst.object":_ -> MTSingularJSON "application/vnd.pgrst.object":_ -> MTSingularJSON
"application/x-www-form-urlencoded":_ -> MTUrlEncoded "application/x-www-form-urlencoded":_ -> MTUrlEncoded
"application/octet-stream":_ -> MTOctetStream "application/octet-stream":_ -> MTOctetStream
"application/vnd.pgrst.plan":rest -> getPlan Nothing rest "application/vnd.pgrst.plan":rest -> getPlan PlanText rest
"application/vnd.pgrst.plan+text":rest -> getPlan (Just PlanText) rest "application/vnd.pgrst.plan+text":rest -> getPlan PlanText rest
"application/vnd.pgrst.plan+json":rest -> getPlan (Just PlanJSON) rest "application/vnd.pgrst.plan+json":rest -> getPlan PlanJSON rest
"*/*":_ -> MTAny "*/*":_ -> MTAny
other:_ -> MTOther other other:_ -> MTOther other
_ -> MTAny _ -> MTAny
where where
getPlan fmt rest = getPlan fmt rest =
let let
opts = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest) opts = BS.split (BS.c2w '|') $ fromMaybe mempty (BS.stripPrefix "options=" =<< find (BS.isPrefixOf "options=") rest)
inOpts str = str `elem` opts 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
dropAround p = BS.dropWhile p . BS.dropWhileEnd p in mtFor = fromMaybe MTApplicationJSON $ do
MTPlan mtFor fmt $ foundFor <- find (BS.isPrefixOf "for=") rest
[PlanAnalyze | inOpts "analyze" ] ++ strippedFor <- BS.stripPrefix "for=" foundFor
[PlanVerbose | inOpts "verbose" ] ++ pure . decodeMediaType $ dropAround (== BS.c2w '"') strippedFor
[PlanSettings | inOpts "settings"] ++ in
[PlanBuffers | inOpts "buffers" ] ++ MTPlan mtFor fmt $
[PlanWAL | inOpts "wal" ] [PlanAnalyze | inOpts "analyze" ] ++
[PlanVerbose | inOpts "verbose" ] ++
[PlanSettings | inOpts "settings"] ++
[PlanBuffers | inOpts "buffers" ] ++
[PlanWAL | inOpts "wal" ]
getMediaType :: MediaType -> MediaType getMediaType :: MediaType -> MediaType
getMediaType mt = case mt of getMediaType mt = case mt of
MTPlan (Just mType) _ _ -> mType MTPlan mType _ _ -> mType
MTPlan Nothing _ _ -> MTApplicationJSON other -> other
other -> other
+4 -4
View File
@@ -633,10 +633,10 @@ binaryField AppConfig{configRawMediaTypes} acceptMediaType proc rpTree
where where
isRawMediaType = acceptMediaType `elem` configRawMediaTypes `L.union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan acceptMediaType isRawMediaType = acceptMediaType `elem` configRawMediaTypes `L.union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan acceptMediaType
isRawPlan mt = case mt of isRawPlan mt = case mt of
MTPlan (Just MTOctetStream) _ _ -> True MTPlan MTOctetStream _ _ -> True
MTPlan (Just MTTextPlain) _ _ -> True MTPlan MTTextPlain _ _ -> True
MTPlan (Just MTTextXML) _ _ -> True MTPlan MTTextXML _ _ -> True
_ -> False _ -> False
fstFieldName :: ReadPlanTree -> Maybe FieldName fstFieldName :: ReadPlanTree -> Maybe FieldName
fstFieldName (Node ReadPlan{select=(("*", []), _, _):_} []) = Nothing fstFieldName (Node ReadPlan{select=(("*", []), _, _):_} []) = Nothing
+3 -4
View File
@@ -431,7 +431,7 @@ intercalateSnippet :: ByteString -> [SQL.Snippet] -> SQL.Snippet
intercalateSnippet _ [] = mempty intercalateSnippet _ [] = mempty
intercalateSnippet frag snippets = foldr1 (\a b -> a <> SQL.sql frag <> b) snippets 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 = explainF fmt opts snip =
"EXPLAIN (" <> "EXPLAIN (" <>
SQL.sql (BS.intercalate ", " (fmtPlanFmt fmt : (fmtPlanOpt <$> opts))) <> SQL.sql (BS.intercalate ", " (fmtPlanFmt fmt : (fmtPlanOpt <$> opts))) <>
@@ -444,9 +444,8 @@ explainF fmt opts snip =
fmtPlanOpt PlanBuffers = "BUFFERS" fmtPlanOpt PlanBuffers = "BUFFERS"
fmtPlanOpt PlanWAL = "WAL" fmtPlanOpt PlanWAL = "WAL"
fmtPlanFmt Nothing = "FORMAT TEXT" fmtPlanFmt PlanText = "FORMAT TEXT"
fmtPlanFmt (Just PlanJSON) = "FORMAT JSON" fmtPlanFmt PlanJSON = "FORMAT JSON"
fmtPlanFmt (Just PlanText) = "FORMAT TEXT"
-- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL. -- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.
setConfigLocal :: ByteString -> (ByteString, ByteString) -> SQL.Snippet setConfigLocal :: ByteString -> (ByteString, ByteString) -> SQL.Snippet
+1 -1
View File
@@ -167,7 +167,7 @@ preparePlanRows :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64)
preparePlanRows countQuery = preparePlanRows countQuery =
SQL.dynamicallyParameterized snippet decodeIt SQL.dynamicallyParameterized snippet decodeIt
where where
snippet = explainF (Just PlanJSON) mempty countQuery snippet = explainF PlanJSON mempty countQuery
decodeIt :: HD.Result (Maybe Int64) decodeIt :: HD.Result (Maybe Int64)
decodeIt = decodeIt =
let row = HD.singleRow $ column HD.bytea in let row = HD.singleRow $ column HD.bytea in
+14 -14
View File
@@ -33,7 +33,7 @@ spec actualPgVersion = do
resStatus = simpleStatus r resStatus = simpleStatus r
liftIO $ do 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" } resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
totalCost `shouldBe` totalCost `shouldBe`
if actualPgVersion > pgVersion120 if actualPgVersion > pgVersion120
@@ -49,7 +49,7 @@ spec actualPgVersion = do
resStatus = simpleStatus r resStatus = simpleStatus r
liftIO $ do 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" } resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
totalCost `shouldBe` totalCost `shouldBe`
if actualPgVersion > pgVersion120 if actualPgVersion > pgVersion120
@@ -65,7 +65,7 @@ spec actualPgVersion = do
resHeaders = simpleHeaders r resHeaders = simpleHeaders r
liftIO $ do 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)) resBody `shouldSatisfy` (\t -> T.isInfixOf "Shared Hit Blocks" (decodeUtf8 $ BS.toStrict t))
else do else do
-- analyze is required for buffers on pg < 13 -- analyze is required for buffers on pg < 13
@@ -75,7 +75,7 @@ spec actualPgVersion = do
resHeaders = simpleHeaders r resHeaders = simpleHeaders r
liftIO $ do 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 |] blocks `shouldBe` Just [aesonQQ| 1.0 |]
when (actualPgVersion >= pgVersion120) $ when (actualPgVersion >= pgVersion120) $
@@ -86,7 +86,7 @@ spec actualPgVersion = do
resHeaders = simpleHeaders r resHeaders = simpleHeaders r
liftIO $ do 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` searchPath `shouldBe`
Just [aesonQQ| Just [aesonQQ|
{ {
@@ -102,7 +102,7 @@ spec actualPgVersion = do
resHeaders = simpleHeaders r resHeaders = simpleHeaders r
liftIO $ do 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|] walRecords `shouldBe` Just [aesonQQ|0|]
it "outputs columns info when using the verbose option" $ do it "outputs columns info when using the verbose option" $ do
@@ -112,7 +112,7 @@ spec actualPgVersion = do
resHeaders = simpleHeaders r resHeaders = simpleHeaders r
liftIO $ do 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"] |] cols `shouldBe` Just [aesonQQ| ["projects.id", "projects.name", "projects.client_id"] |]
it "outputs the plan for application/json " $ do it "outputs the plan for application/json " $ do
@@ -151,7 +151,7 @@ spec actualPgVersion = do
resStatus = simpleStatus r resStatus = simpleStatus r
liftIO $ do 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" } resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
totalCost `shouldBe` 3.27 totalCost `shouldBe` 3.27
@@ -164,7 +164,7 @@ spec actualPgVersion = do
resStatus = simpleStatus r resStatus = simpleStatus r
liftIO $ do 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" } resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
totalCost `shouldBe` 12.45 totalCost `shouldBe` 12.45
@@ -177,7 +177,7 @@ spec actualPgVersion = do
resStatus = simpleStatus r resStatus = simpleStatus r
liftIO $ do 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" } resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
totalCost `shouldBe` 15.68 totalCost `shouldBe` 15.68
@@ -191,7 +191,7 @@ spec actualPgVersion = do
resStatus = simpleStatus r resStatus = simpleStatus r
liftIO $ do 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" } resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
totalCost `shouldBe` 1.29 totalCost `shouldBe` 1.29
@@ -216,7 +216,7 @@ spec actualPgVersion = do
resStatus = simpleStatus r resStatus = simpleStatus r
liftIO $ do 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" } resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
totalCost `shouldBe` 68.56 totalCost `shouldBe` 68.56
@@ -241,7 +241,7 @@ spec actualPgVersion = do
resStatus = simpleStatus r resStatus = simpleStatus r
liftIO $ do 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" } resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
resBody `shouldSatisfy` (\t -> LBS.take 9 t == "Aggregate") resBody `shouldSatisfy` (\t -> LBS.take 9 t == "Aggregate")
@@ -254,7 +254,7 @@ spec actualPgVersion = do
resStatus = simpleStatus r resStatus = simpleStatus r
liftIO $ do 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" } resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
resBody `shouldSatisfy` (\t -> LBS.take 9 t == "Aggregate") resBody `shouldSatisfy` (\t -> LBS.take 9 t == "Aggregate")