jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Introduced raw-media-types config option (#1349)

Browse Source 
* extracted rawOutputTypes to config variable raw-output-media-types

* removed CTTextHtml from Types.hs
This commit is contained in:
Dan Amoroso
2019-07-22 23:37:53 +00:00
committed by Steve Chávez
parent afb7266f17
commit f5cef205f1
10 changed files with 109 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files
CHANGELOG.md
+3
View File
@@ -9,6 +9,8 @@ This project adheres to [Semantic Versioning](http://semver.org/).
### Added
- #1349, Add user defined raw output media types via `raw-media-types` config option
### Fixed
## [6.0.0] - 2019-06-21
@@ -24,6 +26,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
- #790, Allow override of OpenAPI spec through `root-spec` config option - @steve-chavez
- #1308, Accept `text/plain` and `text/html` for raw output - @steve-chavez
### Fixed
- #1223, Fix incorrect OpenAPI externalDocs url - @steve-chavez
postgrest.cabal
+2
View File
@@ -141,6 +141,8 @@ test-suite spec
Feature.StructureSpec
Feature.UnicodeSpec
Feature.UpsertSpec
Feature.RawOutputTypesSpec
Feature.HtmlRawOutputSpec
SpecHelper
TestTypes
hs-source-dirs: test
src/PostgREST/App.hs
+16 -11
View File
@@ -8,6 +8,7 @@ module PostgREST.App (
import qualified Data.ByteString.Char8 as BS
import qualified Data.HashMap.Strict as M
import qualified Data.List as L (union)
import qualified Data.Set as S
import qualified Hasql.Pool as P
import qualified Hasql.Transaction as H
@@ -56,7 +57,6 @@ postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> I
postgrest conf refDbStructure pool getTime worker =
let middle = (if configQuiet conf then id else logStdout) . defaultMiddle
jwtSecret = parseSecret <$> configJwtSecret conf in
middle $ \ req respond -> do
time <- getTime
body <- strictRequestBody req
@@ -103,14 +103,14 @@ transactionMode proc action =
app :: DbStructure -> Maybe ProcDescription -> S.Set FieldName -> AppConfig -> ApiRequest -> H.Transaction Response
app dbStructure proc cols conf apiRequest =
case responseContentTypeOrError (iAccepts apiRequest) (iAction apiRequest) (iTarget apiRequest) of
case responseContentTypeOrError (iAccepts apiRequest) rawContentTypes (iAction apiRequest) (iTarget apiRequest) of
Left errorResponse -> return errorResponse
Right contentType ->
case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
(ActionRead, TargetIdent qi, Nothing) ->
let partsField = (,) <$> readSqlParts
<*> (binaryField contentType =<< fldNames) in
<*> (binaryField contentType rawContentTypes =<< fldNames) in
case partsField of
Left errorResponse -> return errorResponse
Right ((q, cq), bField) -> do
@@ -265,7 +265,7 @@ app dbStructure proc cols conf apiRequest =
_ -> False
rpcBinaryField = if returnsScalar
then Right Nothing
else binaryField contentType =<< fldNames
else binaryField contentType rawContentTypes =<< fldNames
parts = (,) <$> readSqlParts <*> rpcBinaryField in
case parts of
Left errorResponse -> return errorResponse
@@ -329,17 +329,22 @@ app dbStructure proc cols conf apiRequest =
mutateSqlParts s t =
(,) <$> selectQuery
<*> (requestToQuery schema False . DbMutate <$> mutationDbRequest s t)
rawContentTypes =
(decodeContentType <$> configRawMediaTypes conf) `L.union`
[ CTOctetStream, CTTextPlain ]
responseContentTypeOrError :: [ContentType] -> Action -> Target -> Either Response ContentType
responseContentTypeOrError accepts action target = serves contentTypesForRequest accepts
responseContentTypeOrError :: [ContentType] -> [ContentType] -> Action -> Target -> Either Response ContentType
responseContentTypeOrError accepts rawContentTypes action target = serves contentTypesForRequest accepts
where
contentTypesForRequest = case action of
ActionRead -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] ++ rawContentTypes
ActionRead -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
++ rawContentTypes
ActionCreate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
ActionUpdate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
ActionDelete -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
ActionInvoke _ -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] ++ rawContentTypes ++
[CTOpenAPI | tpIsRootSpec target]
ActionInvoke _ -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
++ rawContentTypes
++ [CTOpenAPI | tpIsRootSpec target]
ActionInspect -> [CTOpenAPI, CTApplicationJSON]
ActionInfo -> [CTTextCSV]
ActionSingleUpsert -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
@@ -352,8 +357,8 @@ responseContentTypeOrError accepts action target = serves contentTypesForRequest
| If raw(binary) output is requested, check that ContentType is one of the admitted rawContentTypes and that
| `?select=...` contains only one field other than `*`
-}
binaryField :: ContentType -> [FieldName] -> Either Response (Maybe FieldName)
binaryField ct fldNames
binaryField :: ContentType -> [ContentType]-> [FieldName] -> Either Response (Maybe FieldName)
binaryField ct rawContentTypes fldNames
| ct `elem` rawContentTypes =
let fieldName = headMay fldNames in
if length fldNames == 1 && fieldName /= Just "*"
src/PostgREST/Config.hs
+11
View File
@@ -88,6 +88,7 @@ data AppConfig = AppConfig {
, configExtraSearchPath :: [Text]
, configRootSpec :: Maybe QualifiedIdentifier
, configRawMediaTypes :: [B.ByteString]
}
configPoolTimeout' :: (Fractional a) => AppConfig -> a
@@ -168,6 +169,7 @@ readOptions = do
<*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> optValue "role-claim-key")
<*> (maybe ["public"] splitExtraSearchPath <$> optValue "db-extra-search-path")
<*> ((\x y -> QualifiedIdentifier x <$> y) <$> dbSchema <*> optString "root-spec")
<*> (fmap encodeUtf8 <$> optionalListOfText "raw-media-types")
parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI)
parseJwtAudience k =
@@ -178,6 +180,12 @@ readOptions = do
(Just "") -> pure Nothing
aud' -> pure aud'
optionalListOfText :: C.Key -> C.Parser C.Config [Text]
optionalListOfText k =
C.optional k (C.list C.string) >>= \case
Nothing -> pure []
Just types -> pure types
reqString :: C.Key -> C.Parser C.Config Text
reqString k = C.required k C.string
@@ -273,6 +281,9 @@ readOptions = do
|## stored proc that overrides the root "/" spec
|## it must be inside the db-schema
|# root-spec = "stored_proc_name"
|
|## content types to produce raw output
|# raw-media-types=["image/png","image/jpg"]
|]
pathParser :: Parser FilePath
src/PostgREST/Types.hs
+1 -7
View File
@@ -24,7 +24,7 @@ import Protolude
-- | Enumeration of currently supported response content types
data ContentType = CTApplicationJSON | CTSingularJSON
| CTTextCSV | CTTextPlain | CTTextHtml
| CTTextCSV | CTTextPlain
| CTOpenAPI | CTOctetStream
| CTAny | CTOther ByteString deriving (Show, Eq)
@@ -37,7 +37,6 @@ toMime :: ContentType -> ByteString
toMime CTApplicationJSON = "application/json"
toMime CTTextCSV = "text/csv"
toMime CTTextPlain = "text/plain"
toMime CTTextHtml = "text/html"
toMime CTOpenAPI = "application/openapi+json"
toMime CTSingularJSON = "application/vnd.pgrst.object+json"
toMime CTOctetStream = "application/octet-stream"
@@ -50,7 +49,6 @@ decodeContentType ct = case BS.takeWhile (/= BS.c2w ';') ct of
"application/json" -> CTApplicationJSON
"text/csv" -> CTTextCSV
"text/plain" -> CTTextPlain
"text/html" -> CTTextHtml
"application/openapi+json" -> CTOpenAPI
"application/vnd.pgrst.object+json" -> CTSingularJSON
"application/vnd.pgrst.object" -> CTSingularJSON
@@ -58,10 +56,6 @@ decodeContentType ct = case BS.takeWhile (/= BS.c2w ';') ct of
"*/*" -> CTAny
ct' -> CTOther ct'
-- | ContentTypes that can get a raw/unwrapped response
rawContentTypes :: [ContentType]
rawContentTypes = [CTOctetStream, CTTextPlain, CTTextHtml]
data PreferResolution = MergeDuplicates | IgnoreDuplicates deriving Eq
instance Show PreferResolution where
show MergeDuplicates = "resolution=merge-duplicates"
test/Feature/HtmlRawOutputSpec.hs
+30
View File
@@ -0,0 +1,30 @@
module Feature.HtmlRawOutputSpec where
import Network.Wai (Application)
import Network.HTTP.Types
import Test.Hspec hiding (pendingWith)
import Test.Hspec.Wai
import Text.Heredoc
import Protolude hiding (get)
import SpecHelper (acceptHdrs)
spec :: SpecWith Application
spec = describe "When raw-media-types is set to \"text/html\"" $
it "can get raw output with Accept: text/html" $
request methodGet "/rpc/welcome.html" (acceptHdrs "text/html") ""
`shouldRespondWith`
[str|
|<html>
| <head>
| <title>PostgREST</title>
| </head>
| <body>
| <h1>Welcome to PostgREST</h1>
| </body>
|</html>
|]
{ matchStatus = 200
, matchHeaders = ["Content-Type" <:> "text/html; charset=utf-8"]
}
test/Feature/RawOutputTypesSpec.hs
+33
View File
@@ -0,0 +1,33 @@
module Feature.RawOutputTypesSpec where
import Network.Wai (Application)
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Protolude
import SpecHelper (acceptHdrs)
spec :: SpecWith Application
spec = describe "When raw-media-types config variable is missing or left empty" $ do
let firefoxAcceptHdrs = acceptHdrs "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
chromeAcceptHdrs = acceptHdrs "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3"
it "responds json to a GET request with Firefox Accept headers" $
request methodGet "/items?id=eq.1" firefoxAcceptHdrs ""
`shouldRespondWith` [json| [{"id":1}] |]
{ matchHeaders= ["Content-Type" <:> "application/json; charset=utf-8"] }
it "responds json to a GET request with Chrome Accept headers" $
request methodGet "/items?id=eq.1" chromeAcceptHdrs ""
`shouldRespondWith` [json| [{"id":1}] |]
{ matchHeaders= ["Content-Type" <:> "application/json; charset=utf-8"] }
it "responds json to a GET request to RPC with Firefox Accept headers" $
request methodGet "/rpc/get_projects_below?id=3" chromeAcceptHdrs ""
`shouldRespondWith` [json|[{"id":1,"name":"Windows 7","client_id":1}, {"id":2,"name":"Windows 10","client_id":1}]|]
{ matchHeaders= ["Content-Type" <:> "application/json; charset=utf-8"] }
it "responds json to a GET request to RPC with Chrome Accept headers" $
request methodGet "/rpc/get_projects_below?id=3" chromeAcceptHdrs ""
`shouldRespondWith` [json|[{"id":1,"name":"Windows 7","client_id":1}, {"id":2,"name":"Windows 10","client_id":1}]|]
{ matchHeaders= ["Content-Type" <:> "application/json; charset=utf-8"] }
test/Feature/RpcSpec.hs
-17
View File
@@ -464,23 +464,6 @@ spec actualPgVersion =
, matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"]
}
it "can get raw output with Accept: text/html" $
request methodGet "/rpc/welcome.html" (acceptHdrs "text/html") ""
`shouldRespondWith`
[str|
|<html>
| <head>
| <title>PostgREST</title>
| </head>
| <body>
| <h1>Welcome to PostgREST</h1>
| </body>
|</html>
|]
{ matchStatus = 200
, matchHeaders = ["Content-Type" <:> "text/html; charset=utf-8"]
}
it "can get raw output with Accept: text/plain" $
request methodGet "/rpc/welcome" (acceptHdrs "text/plain") ""
`shouldRespondWith` "Welcome to PostgREST"
test/Main.hs
+8
View File
@@ -27,6 +27,7 @@ import qualified Feature.ConcurrentSpec
import qualified Feature.CorsSpec
import qualified Feature.DeleteSpec
import qualified Feature.ExtraSearchPathSpec
import qualified Feature.HtmlRawOutputSpec
import qualified Feature.InsertSpec
import qualified Feature.JsonOperatorSpec
import qualified Feature.NoJwtSpec
@@ -37,6 +38,7 @@ import qualified Feature.ProxySpec
import qualified Feature.QueryLimitedSpec
import qualified Feature.QuerySpec
import qualified Feature.RangeSpec
import qualified Feature.RawOutputTypesSpec
import qualified Feature.RootSpec
import qualified Feature.RpcSpec
import qualified Feature.SingularSpec
@@ -74,6 +76,7 @@ main = do
nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn) refDbStructure pool getTime $ pure ()
extraSearchPathApp = return $ postgrest (testCfgExtraSearchPath testDbConn) refDbStructure pool getTime $ pure ()
rootSpecApp = return $ postgrest (testCfgRootSpec testDbConn) refDbStructure pool getTime $ pure ()
htmlRawOutputApp = return $ postgrest (testCfgHtmlRawOutput testDbConn) refDbStructure pool getTime $ pure ()
let reset :: IO ()
reset = resetDb testDbConn
@@ -86,6 +89,7 @@ main = do
specs = uncurry describe <$> [
("Feature.AuthSpec" , Feature.AuthSpec.spec actualPgVersion)
, ("Feature.RawOutputTypesSpec" , Feature.RawOutputTypesSpec.spec)
, ("Feature.ConcurrentSpec" , Feature.ConcurrentSpec.spec)
, ("Feature.CorsSpec" , Feature.CorsSpec.spec)
, ("Feature.DeleteSpec" , Feature.DeleteSpec.spec)
@@ -102,6 +106,10 @@ main = do
hspec $ do
mapM_ (beforeAll_ reset . before withApp) specs
-- this test runs with a raw-output-media-types set to text/html
beforeAll_ reset . before htmlRawOutputApp $
describe "Feature.HtmlRawOutputSpec" Feature.HtmlRawOutputSpec.spec
-- this test runs with a different server flag
beforeAll_ reset . before ltdApp $
describe "Feature.QueryLimitedSpec" Feature.QueryLimitedSpec.spec
test/SpecHelper.hs
+5
View File
@@ -81,6 +81,8 @@ _baseCfg = -- Connection Settings
[]
-- No root spec override
Nothing
-- Raw output media types
[]
testCfg :: Text -> AppConfig
testCfg testDbConn = _baseCfg { configDatabase = testDbConn }
@@ -131,6 +133,9 @@ testCfgExtraSearchPath testDbConn = (testCfg testDbConn) { configExtraSearchPath
testCfgRootSpec :: Text -> AppConfig
testCfgRootSpec testDbConn = (testCfg testDbConn) { configRootSpec = Just $ QualifiedIdentifier "test" "root"}
testCfgHtmlRawOutput :: Text -> AppConfig
testCfgHtmlRawOutput testDbConn = (testCfg testDbConn) { configRawMediaTypes = ["text/html"] }
setupDb :: Text -> IO ()
setupDb dbConn = do
loadFixture dbConn "database"