diff --git a/CHANGELOG.md b/CHANGELOG.md index 78ba7b1ea..a5e617a77 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index 5b95418ce..bf34c895a 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -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 diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 3b7f300cc..4bb4006fa 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -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 = diff --git a/src/PostgREST/DbRequestBuilder.hs b/src/PostgREST/DbRequestBuilder.hs index b1e1317e5..931d23fa6 100644 --- a/src/PostgREST/DbRequestBuilder.hs +++ b/src/PostgREST/DbRequestBuilder.hs @@ -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 diff --git a/test/Feature/RangeSpec.hs b/test/Feature/RangeSpec.hs index c1c8f033e..b0c0ba034 100644 --- a/test/Feature/RangeSpec.hs +++ b/test/Feature/RangeSpec.hs @@ -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" diff --git a/test/Feature/RpcSpec.hs b/test/Feature/RpcSpec.hs index 63874e63c..11b8612fb 100644 --- a/test/Feature/RpcSpec.hs +++ b/test/Feature/RpcSpec.hs @@ -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" $ diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs index dbdd5bb93..c84185205 100644 --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -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"