Skip to content

Commit

Permalink
refactor: remove MTPlanAttrs to doctest
Browse files Browse the repository at this point in the history
  • Loading branch information
steve-chavez committed Jun 18, 2023
1 parent 5d7643c commit f6b58a5
Show file tree
Hide file tree
Showing 7 changed files with 62 additions and 36 deletions.
6 changes: 2 additions & 4 deletions src/PostgREST/ApiRequest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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]
62 changes: 45 additions & 17 deletions src/PostgREST/MediaType.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,6 @@ module PostgREST.MediaType
( MediaType(..)
, MTPlanOption (..)
, MTPlanFormat (..)
, MTPlanAttrs(..)
, toContentType
, toMime
, decodeMediaType
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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))

Expand All @@ -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) Nothing []
--
-- >>> decodeMediaType "application/vnd.pgrst.plan+text;for=\"text/csv\""
-- MTPlan (Just MTTextCSV) (Just PlanText) []
decodeMediaType :: BS.ByteString -> MediaType
decodeMediaType mt =
case BS.split (BS.c2w ';') mt of
Expand All @@ -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
Expand All @@ -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"] ++
Expand All @@ -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
11 changes: 5 additions & 6 deletions src/PostgREST/Plan.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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
Expand Down
7 changes: 4 additions & 3 deletions src/PostgREST/Query/SqlFragment.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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))) <>
Expand All @@ -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
Expand Down
9 changes: 4 additions & 5 deletions src/PostgREST/Query/Statements.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
1 change: 1 addition & 0 deletions test/doc/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,4 +16,5 @@ main =
, "src/PostgREST/ApiRequest/Preferences.hs"
, "src/PostgREST/ApiRequest/QueryParams.hs"
, "src/PostgREST/Error.hs"
, "src/PostgREST/MediaType.hs"
]
2 changes: 1 addition & 1 deletion test/spec/Feature/Query/PlanSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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")

Expand Down

0 comments on commit f6b58a5

Please sign in to comment.