From 750275f37bc9243195e1ba4219bd37751de132ab Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Sun, 18 Jun 2023 14:02:00 -0500 Subject: [PATCH] refactor: remove MTPlanAttrs to doctest --- src/PostgREST/ApiRequest.hs | 6 +-- src/PostgREST/MediaType.hs | 62 +++++++++++++++++++++-------- src/PostgREST/Plan.hs | 11 +++-- src/PostgREST/Query/SqlFragment.hs | 7 ++-- src/PostgREST/Query/Statements.hs | 9 ++--- test/doc/Main.hs | 1 + test/spec/Feature/Query/PlanSpec.hs | 2 +- 7 files changed, 62 insertions(+), 36 deletions(-) diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index cddee8b5d42..3bc0231e06d 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -51,9 +51,7 @@ import PostgREST.ApiRequest.Types (ApiRequestError (..), RangeError (..)) import PostgREST.Config (AppConfig (..), OpenAPIMode (..)) -import PostgREST.MediaType (MTPlanAttrs (..), - MTPlanFormat (..), - MediaType (..)) +import PostgREST.MediaType (MediaType (..)) import PostgREST.RangeQuery (NonnegRange, allRange, convertToLimitZeroRange, hasLimitZero, @@ -375,5 +373,5 @@ producedMediaTypes conf action path = ++ [MTOpenAPI | pathIsRootSpec path] defaultMediaTypes = [MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++ - [MTPlan $ MTPlanAttrs Nothing PlanJSON mempty | configDbPlanEnabled conf] ++ [MTAny] + [MTPlan Nothing Nothing mempty | configDbPlanEnabled conf] ++ [MTAny] rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML] diff --git a/src/PostgREST/MediaType.hs b/src/PostgREST/MediaType.hs index 39840a80d76..4e58e76c56d 100644 --- a/src/PostgREST/MediaType.hs +++ b/src/PostgREST/MediaType.hs @@ -4,7 +4,6 @@ module PostgREST.MediaType ( MediaType(..) , MTPlanOption (..) , MTPlanFormat (..) - , MTPlanAttrs(..) , toContentType , toMime , decodeMediaType @@ -19,6 +18,14 @@ import Network.HTTP.Types.Header (Header, hContentType) import Protolude +-- +-- $setup +-- Setup for doctests +-- >>> import Text.Pretty.Simple (pPrint) +-- >>> deriving instance Show MTPlanFormat +-- >>> deriving instance Show MTPlanOption +-- >>> deriving instance Show MediaType + -- | Enumeration of currently supported media types data MediaType = MTApplicationJSON @@ -32,12 +39,21 @@ data MediaType | MTOctetStream | MTAny | MTOther ByteString - | MTPlan MTPlanAttrs - deriving Eq - -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 + | MTPlan (Maybe MediaType) (Maybe MTPlanFormat) [MTPlanOption] +instance Eq MediaType where + MTApplicationJSON == MTApplicationJSON = True + MTSingularJSON == MTSingularJSON = True + MTGeoJSON == MTGeoJSON = True + MTTextCSV == MTTextCSV = True + MTTextPlain == MTTextPlain = True + MTTextXML == MTTextXML = True + MTOpenAPI == MTOpenAPI = True + MTUrlEncoded == MTUrlEncoded = True + MTOctetStream == MTOctetStream = True + MTAny == MTAny = True + MTOther x == MTOther y = x == y + MTPlan{} == MTPlan{} = True + _ == _ = False data MTPlanOption = PlanAnalyze | PlanVerbose | PlanSettings | PlanBuffers | PlanWAL @@ -67,8 +83,8 @@ toMime MTUrlEncoded = "application/x-www-form-urlencoded" toMime MTOctetStream = "application/octet-stream" toMime MTAny = "*/*" toMime (MTOther ct) = ct -toMime (MTPlan (MTPlanAttrs mt fmt opts)) = - "application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <> +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) <> "\"") <> (if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts)) @@ -83,7 +99,19 @@ toMimePlanFormat :: MTPlanFormat -> ByteString toMimePlanFormat PlanJSON = "json" toMimePlanFormat PlanText = "text" --- | Convert from ByteString to MediaType. Warning: discards MIME parameters +-- | Convert from ByteString to MediaType. +-- +-- >>> decodeMediaType "application/json" +-- MTApplicationJSON +-- +-- >>> decodeMediaType "application/vnd.pgrst.plan;" +-- MTPlan Nothing Nothing [] +-- +-- >>> decodeMediaType "application/vnd.pgrst.plan;for=\"application/json\"" +-- MTPlan (Just MTApplicationJSON) PlanText [] +-- +-- >>> decodeMediaType "application/vnd.pgrst.plan;for=\"text/csv\"" +-- MTPlan (Just MTTextCSV) PlanText [] decodeMediaType :: BS.ByteString -> MediaType decodeMediaType mt = case BS.split (BS.c2w ';') mt of @@ -97,9 +125,9 @@ decodeMediaType mt = "application/vnd.pgrst.object":_ -> MTSingularJSON "application/x-www-form-urlencoded":_ -> MTUrlEncoded "application/octet-stream":_ -> MTOctetStream - "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 + "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 "*/*":_ -> MTAny other:_ -> MTOther other _ -> MTAny @@ -110,7 +138,7 @@ decodeMediaType mt = 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 $ + MTPlan mtFor fmt $ [PlanAnalyze | inOpts "analyze" ] ++ [PlanVerbose | inOpts "verbose" ] ++ [PlanSettings | inOpts "settings"] ++ @@ -119,6 +147,6 @@ decodeMediaType mt = getMediaType :: MediaType -> MediaType getMediaType mt = case mt of - MTPlan (MTPlanAttrs (Just mType) _ _) -> mType - MTPlan (MTPlanAttrs Nothing _ _) -> MTApplicationJSON - other -> other + MTPlan (Just mType) _ _ -> mType + MTPlan Nothing _ _ -> MTApplicationJSON + other -> other diff --git a/src/PostgREST/Plan.hs b/src/PostgREST/Plan.hs index 4714e8f15fa..b6d9abe070e 100644 --- a/src/PostgREST/Plan.hs +++ b/src/PostgREST/Plan.hs @@ -44,8 +44,7 @@ import PostgREST.ApiRequest (Action (..), Payload (..)) import PostgREST.Config (AppConfig (..)) import PostgREST.Error (Error (..)) -import PostgREST.MediaType (MTPlanAttrs (..), - MediaType (..)) +import PostgREST.MediaType (MediaType (..)) import PostgREST.Query.SqlFragment (sourceCTEName) import PostgREST.RangeQuery (NonnegRange, allRange, convertToLimitZeroRange, @@ -634,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 (MTPlanAttrs (Just MTOctetStream) _ _) -> True - MTPlan (MTPlanAttrs (Just MTTextPlain) _ _) -> True - MTPlan (MTPlanAttrs (Just MTTextXML) _ _) -> True - _ -> False + MTPlan (Just MTOctetStream) _ _ -> True + MTPlan (Just MTTextPlain) _ _ -> True + MTPlan (Just 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 9e735e94c50..ea150ec4288 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 :: MTPlanFormat -> [MTPlanOption] -> SQL.Snippet -> SQL.Snippet +explainF :: Maybe MTPlanFormat -> [MTPlanOption] -> SQL.Snippet -> SQL.Snippet explainF fmt opts snip = "EXPLAIN (" <> SQL.sql (BS.intercalate ", " (fmtPlanFmt fmt : (fmtPlanOpt <$> opts))) <> @@ -444,8 +444,9 @@ explainF fmt opts snip = fmtPlanOpt PlanBuffers = "BUFFERS" fmtPlanOpt PlanWAL = "WAL" - fmtPlanFmt PlanJSON = "FORMAT JSON" - fmtPlanFmt PlanText = "FORMAT TEXT" + fmtPlanFmt Nothing = "FORMAT TEXT" + fmtPlanFmt (Just PlanJSON) = "FORMAT JSON" + fmtPlanFmt (Just PlanText) = "FORMAT TEXT" -- | 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 99e5ef5ccda..03fff7feed7 100644 --- a/src/PostgREST/Query/Statements.hs +++ b/src/PostgREST/Query/Statements.hs @@ -26,8 +26,7 @@ import Control.Lens ((^?)) import Data.Maybe (fromJust) import PostgREST.ApiRequest.Preferences -import PostgREST.MediaType (MTPlanAttrs (..), - MTPlanFormat (..), +import PostgREST.MediaType (MTPlanFormat (..), MediaType (..), getMediaType) import PostgREST.Query.SqlFragment @@ -168,7 +167,7 @@ preparePlanRows :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64) preparePlanRows countQuery = SQL.dynamicallyParameterized snippet decodeIt where - snippet = explainF PlanJSON mempty countQuery + snippet = explainF (Just PlanJSON) mempty countQuery decodeIt :: HD.Result (Maybe Int64) decodeIt = let row = HD.singleRow $ column HD.bytea in @@ -188,8 +187,8 @@ standardRow noLocation = mtSnippet :: MediaType -> SQL.Snippet -> SQL.Snippet mtSnippet mediaType snippet = case mediaType of - MTPlan (MTPlanAttrs _ fmt opts) -> explainF fmt opts snippet - _ -> snippet + MTPlan _ 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. planRow :: HD.Result ResultSet diff --git a/test/doc/Main.hs b/test/doc/Main.hs index 818a498659b..25361d189f4 100644 --- a/test/doc/Main.hs +++ b/test/doc/Main.hs @@ -16,4 +16,5 @@ main = , "src/PostgREST/ApiRequest/Preferences.hs" , "src/PostgREST/ApiRequest/QueryParams.hs" , "src/PostgREST/Error.hs" + , "src/PostgREST/MediaType.hs" ] diff --git a/test/spec/Feature/Query/PlanSpec.hs b/test/spec/Feature/Query/PlanSpec.hs index eb21d95c5d6..e88dec51484 100644 --- a/test/spec/Feature/Query/PlanSpec.hs +++ b/test/spec/Feature/Query/PlanSpec.hs @@ -254,7 +254,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; charset=utf-8") resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" } resBody `shouldSatisfy` (\t -> LBS.take 9 t == "Aggregate")