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

Add support for HEAD request

Browse Source
This commit is contained in:
steve-chavez
2019-09-03 13:38:53 -05:00
committed by Steve Chávez
parent 68cbe34c11
commit 620721dea7
7 changed files with 90 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files
CHANGELOG.md
+2
View File
@@ -7,6 +7,8 @@ This project adheres to [Semantic Versioning](http://semver.org/).
### Added
- #1383, Add support for HEAD request - @steve-chavez
### Fixed
## [6.0.2] - 2019-08-22
src/PostgREST/ApiRequest.hs
+36 -18
View File
@@ -6,6 +6,7 @@ Description : PostgREST functions to translate HTTP request to a domain type cal
module PostgREST.ApiRequest (
ApiRequest(..)
, InvokeMethod(..)
, ContentType(..)
, Action(..)
, Target(..)
@@ -51,11 +52,12 @@ import Protolude
type RequestBody = BL.ByteString
data InvokeMethod = InvHead | InvGet | InvPost deriving Eq
-- | Types of things a user wants to do to tables/views/procs
data Action = ActionCreate | ActionRead
| ActionUpdate | ActionDelete
| ActionInfo | ActionInvoke{isReadOnly :: Bool}
| ActionInspect | ActionSingleUpsert
data Action = ActionCreate | ActionRead{isHead :: Bool}
| ActionUpdate | ActionDelete
| ActionSingleUpsert | ActionInvoke InvokeMethod
| ActionInfo | ActionInspect{isHead :: Bool}
deriving Eq
-- | The target db object of a user action
data Target = TargetIdent QualifiedIdentifier
@@ -117,7 +119,7 @@ data ApiRequest = ApiRequest {
-- | Examines HTTP request and translates it into user intent.
userApiRequest :: Schema -> Maybe QualifiedIdentifier -> Request -> RequestBody -> Either ApiRequestError ApiRequest
userApiRequest schema rootSpec req reqBody
| isTargetingProc && method `notElem` ["GET", "POST"] = Left ActionInappropriate
| isTargetingProc && method `notElem` ["HEAD", "GET", "POST"] = Left ActionInappropriate
| topLevelRange == emptyRange = Left InvalidRange
| shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) witness payload
| otherwise = Right ApiRequest {
@@ -152,8 +154,10 @@ userApiRequest schema rootSpec req reqBody
-- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
(filters, rpcQParams) =
case action of
ActionInvoke{isReadOnly=True} -> partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
_ -> (flts, [])
ActionInvoke InvGet -> partitionFlts
ActionInvoke InvHead -> partitionFlts
_ -> (flts, [])
partitionFlts = partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
flts =
[ (toS k, toS $ fromJust v) |
(k,v) <- qParams, isJust v,
@@ -167,12 +171,13 @@ userApiRequest schema rootSpec req reqBody
TargetProc _ _ -> True
_ -> False
contentType = decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type"
columns | action `elem` [ActionCreate, ActionUpdate, ActionInvoke{isReadOnly=False}] = toS <$> join (lookup "columns" qParams)
| otherwise = Nothing
columns
| action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] = toS <$> join (lookup "columns" qParams)
| otherwise = Nothing
payload =
case (contentType, action) of
(_, ActionInvoke{isReadOnly=True}) ->
Right $ ProcessedJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> rpcQParams) PJObject (S.fromList $ fst <$> rpcQParams)
(_, ActionInvoke InvGet) -> Right rpcPrmsToJson
(_, ActionInvoke InvHead) -> Right rpcPrmsToJson
(CTApplicationJSON, _) ->
if isJust columns
then Right $ RawJSON reqBody
@@ -189,21 +194,27 @@ userApiRequest schema rootSpec req reqBody
Right $ ProcessedJSON (JSON.encode json) PJObject keys
(ct, _) ->
Left $ toS $ "Content-Type not acceptable: " <> toMime ct
rpcPrmsToJson = ProcessedJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> rpcQParams)
PJObject (S.fromList $ fst <$> rpcQParams)
topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges -- if no limit is specified, get all the request rows
action =
case method of
"GET" | target == TargetDefaultSpec -> ActionInspect
| isTargetingProc -> ActionInvoke{isReadOnly=True}
| otherwise -> ActionRead
-- The HEAD method is identical to GET except that the server MUST NOT return a message-body in the response
-- From https://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html#sec9.4
"HEAD" | target == TargetDefaultSpec -> ActionInspect{isHead=True}
| isTargetingProc -> ActionInvoke InvHead
| otherwise -> ActionRead{isHead=True}
"GET" | target == TargetDefaultSpec -> ActionInspect{isHead=False}
| isTargetingProc -> ActionInvoke InvGet
| otherwise -> ActionRead{isHead=False}
"POST" -> if isTargetingProc
then ActionInvoke{isReadOnly=False}
then ActionInvoke InvPost
else ActionCreate
"PATCH" -> ActionUpdate
"PUT" -> ActionSingleUpsert
"DELETE" -> ActionDelete
"OPTIONS" -> ActionInfo
_ -> ActionInspect
_ -> ActionInspect{isHead=False}
target = case path of
[] -> case rootSpec of
Just rsQi -> TargetProc rsQi True
@@ -212,7 +223,14 @@ userApiRequest schema rootSpec req reqBody
["rpc", proc] -> TargetProc (QualifiedIdentifier schema proc) False
other -> TargetUnknown other
shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionInvoke{isReadOnly=False}, ActionInvoke{isReadOnly=True}]
shouldParsePayload =
action `elem`
[ActionCreate, ActionUpdate, ActionSingleUpsert,
ActionInvoke InvPost,
-- Though ActionInvoke{isGet=True}(a GET /rpc/..) doesn't really have a payload, we use the payload variable as a way
-- to store the query string arguments to the function.
ActionInvoke InvGet,
ActionInvoke InvHead]
relevantPayload | shouldParsePayload = rightToMaybe payload
| otherwise = Nothing
path = pathInfo req
src/PostgREST/App.hs
+21 -16
View File
@@ -41,6 +41,7 @@ import Network.Wai
import PostgREST.ApiRequest (Action (..), ApiRequest (..),
ContentType (..),
InvokeMethod (..),
PreferRepresentation (..),
Target (..), mutuallyAgreeable,
userApiRequest)
@@ -55,12 +56,12 @@ import PostgREST.Error (PgError (..), SimpleError (..),
import PostgREST.Middleware
import PostgREST.OpenAPI
import PostgREST.Parsers (pRequestColumns)
import PostgREST.QueryBuilder (callProc,
createReadStatement,
import PostgREST.QueryBuilder (callProc, createReadStatement,
createWriteStatement,
requestToCountQuery,
requestToQuery)
import PostgREST.RangeQuery (allRange, contentRangeH, rangeStatusHeader)
import PostgREST.RangeQuery (allRange, contentRangeH,
rangeStatusHeader)
import PostgREST.Types
import Protolude hiding (Proxy, intercalate)
@@ -101,15 +102,16 @@ postgrest conf refDbStructure pool getTime worker =
transactionMode :: Maybe ProcDescription -> Action -> HT.Mode
transactionMode proc action =
case action of
ActionRead -> HT.Read
ActionInfo -> HT.Read
ActionInspect -> HT.Read
ActionInvoke{isReadOnly=False} ->
ActionRead _ -> HT.Read
ActionInfo -> HT.Read
ActionInspect _ -> HT.Read
ActionInvoke InvGet -> HT.Read
ActionInvoke InvHead -> HT.Read
ActionInvoke InvPost ->
let v = maybe Volatile pdVolatility proc in
if v == Stable || v == Immutable
then HT.Read
else HT.Write
ActionInvoke{isReadOnly=True} -> HT.Read
_ -> HT.Write
app :: DbStructure -> Maybe ProcDescription -> S.Set FieldName -> AppConfig -> ApiRequest -> H.Transaction Response
@@ -119,7 +121,7 @@ app dbStructure proc cols conf apiRequest =
Right contentType ->
case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
(ActionRead, TargetIdent qi, Nothing) ->
(ActionRead headersOnly, TargetIdent qi, Nothing) ->
let partsField = (,) <$> readSqlParts
<*> (binaryField contentType rawContentTypes =<< fldNames) in
case partsField of
@@ -135,7 +137,8 @@ app dbStructure proc cols conf apiRequest =
then errorResponseFor . singularityError $ queryTotal
else responseLBS status
[toHeader contentType, contentRange,
contentLocationH (qiName qi) (iCanonicalQS apiRequest)] (toS body)
contentLocationH (qiName qi) (iCanonicalQS apiRequest)]
(if headersOnly then mempty else toS body)
(ActionCreate, TargetIdent (QualifiedIdentifier tSchema tName), Just pJson) ->
case mutateSqlParts tSchema tName of
@@ -266,7 +269,7 @@ app dbStructure proc cols conf apiRequest =
allOrigins = ("Access-Control-Allow-Origin", "*") :: Header in
return $ responseLBS status200 [allOrigins, allowH] mempty
(ActionInvoke _, TargetProc qi _, Just pJson) ->
(ActionInvoke invMethod, TargetProc qi _, Just pJson) ->
let returnsScalar = case proc of
Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
_ -> False
@@ -294,9 +297,11 @@ app dbStructure proc cols conf apiRequest =
then do
HT.condemn
return . errorResponseFor . singularityError $ queryTotal
else return $ responseLBS status ([toHeader contentType, contentRange] ++ toHeaders hs) (toS body)
else
return $ responseLBS status ([toHeader contentType, contentRange] ++ toHeaders hs)
(if invMethod == InvHead then mempty else toS body)
(ActionInspect, TargetDefaultSpec, Nothing) -> do
(ActionInspect headersOnly, TargetDefaultSpec, Nothing) -> do
let host = configHost conf
port = toInteger $ configPort conf
proxy = pickProxy $ toS <$> configProxyUri conf
@@ -308,7 +313,7 @@ app dbStructure proc cols conf apiRequest =
encodeApi ti sd procs = encodeOpenAPI (concat $ M.elems procs) (toTableInfo ti) uri' sd $ dbPrimaryKeys dbStructure
body <- encodeApi <$> H.statement schema accessibleTables <*> H.statement schema schemaDescription <*> H.statement schema accessibleProcs
return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
return $ responseLBS status200 [toHeader CTOpenAPI] (if headersOnly then mempty else toS body)
_ -> return notFound
@@ -335,7 +340,7 @@ responseContentTypeOrError :: [ContentType] -> [ContentType] -> Action -> Target
responseContentTypeOrError accepts rawContentTypes action target = serves contentTypesForRequest accepts
where
contentTypesForRequest = case action of
ActionRead -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
ActionRead _ -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
++ rawContentTypes
ActionCreate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
ActionUpdate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
@@ -343,7 +348,7 @@ responseContentTypeOrError accepts rawContentTypes action target = serves conten
ActionInvoke _ -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
++ rawContentTypes
++ [CTOpenAPI | tpIsRootSpec target]
ActionInspect -> [CTOpenAPI, CTApplicationJSON]
ActionInspect _ -> [CTOpenAPI, CTApplicationJSON]
ActionInfo -> [CTTextCSV]
ActionSingleUpsert -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
serves sProduces cAccepts =
src/PostgREST/DbRequestBuilder.hs
+4 -2
View File
@@ -72,7 +72,9 @@ readRequest maxRows allRels proc apiRequest =
buildReadRequest :: [Tree SelectItem] -> ReadRequest
buildReadRequest fieldTree =
let rootDepth = 0
rootNodeName = if action == ActionRead then rootTableName else sourceCTEName in
rootNodeName = case action of
ActionRead _ -> rootTableName
_ -> sourceCTEName in
foldr (treeEntry rootDepth) (Node (Select [] rootNodeName Nothing [] [] [] [] allRange, (rootNodeName, Nothing, Nothing, Nothing, rootDepth)) []) fieldTree
where
treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
@@ -278,7 +280,7 @@ addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
(flts, logFrst) =
case action of
ActionInvoke _ -> (iFilters apiRequest, iLogic apiRequest)
ActionRead -> (iFilters apiRequest, iLogic apiRequest)
ActionRead _ -> (iFilters apiRequest, iLogic apiRequest)
_ -> join (***) (filter (( "." `isInfixOf` ) . fst)) (iFilters apiRequest, iLogic apiRequest)
orders :: Either ApiRequestError [(EmbedPath, [OrderTerm])]
orders = mapM pRequestOrder $ iOrder apiRequest
test/Feature/RangeSpec.hs
+6 -1
View File
@@ -155,12 +155,17 @@ spec = do
, matchHeaders = ["Content-Range" <:> "0-0/*"]
}
it "limit and offset works on first level" $
it "limit and offset works on first level" $ do
get "/items?select=id&order=id.asc&limit=3&offset=2"
`shouldRespondWith` [json|[{"id":3},{"id":4},{"id":5}]|]
{ matchStatus = 200
, matchHeaders = ["Content-Range" <:> "2-4/*"]
}
request methodHead "/items?select=id&order=id.asc&limit=3&offset=2" [] mempty
`shouldRespondWith` ""
{ matchStatus = 200
, matchHeaders = ["Content-Range" <:> "2-4/*"]
}
it "succeeds if offset equals 0 as a no-op" $
get "/items?select=id&offset=0"
test/Feature/RpcSpec.hs
+18
View File
@@ -34,6 +34,12 @@ spec actualPgVersion =
{ matchStatus = 200
, matchHeaders = ["Content-Range" <:> "0-0/*"]
}
request methodHead "/rpc/getitemrange?min=2&max=4"
(rangeHdrs (ByteRangeFromTo 0 0)) ""
`shouldRespondWith` ""
{ matchStatus = 200
, matchHeaders = ["Content-Range" <:> "0-0/*"]
}
it "includes total count if requested" $ do
request methodPost "/rpc/getitemrange"
@@ -49,6 +55,12 @@ spec actualPgVersion =
{ matchStatus = 206
, matchHeaders = ["Content-Range" <:> "0-0/2"]
}
request methodHead "/rpc/getitemrange?min=2&max=4"
(rangeHdrsWithCount (ByteRangeFromTo 0 0)) ""
`shouldRespondWith` ""
{ matchStatus = 206
, matchHeaders = ["Content-Range" <:> "0-0/2"]
}
it "returns proper json" $ do
post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith`
@@ -72,6 +84,12 @@ spec actualPgVersion =
{ matchStatus = 200
, matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
}
request methodHead "/rpc/getitemrange?min=2&max=4"
(acceptHdrs "text/csv") ""
`shouldRespondWith` ""
{ matchStatus = 200
, matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]
}
context "unknown function" $ do
it "returns 404" $
test/Feature/StructureSpec.hs
+3 -1
View File
@@ -21,8 +21,10 @@ spec :: SpecWith Application
spec = do
describe "OpenAPI" $ do
it "root path returns a valid openapi spec" $
it "root path returns a valid openapi spec" $ do
validateOpenApiResponse [("Accept", "application/openapi+json")]
request methodHead "/" (acceptHdrs "application/openapi+json") ""
`shouldRespondWith` "" { matchStatus = 200 }
it "should respond to openapi request on none root path with 415" $
request methodGet "/items"