Add option for overriding root spec (#1317)

* Only for pg >= 9.6

* Disallow specifying schema on root-spec

* Increase memory test upper bound
This commit is contained in:
Steve Chávez
2019-06-10 13:45:50 -05:00
committed by GitHub
parent ea82b9f820
commit 1df749a7a8
12 changed files with 129 additions and 36 deletions
+15 -12
View File
@@ -60,8 +60,8 @@ data Action = ActionCreate | ActionRead
deriving Eq
-- | The target db object of a user action
data Target = TargetIdent QualifiedIdentifier
| TargetProc QualifiedIdentifier
| TargetRoot
| TargetProc{tpQi :: QualifiedIdentifier, tpIsRootSpec :: Bool}
| TargetDefaultSpec -- The default spec offered at root "/"
| TargetUnknown [Text]
deriving Eq
-- | How to return the inserted data
@@ -114,8 +114,8 @@ data ApiRequest = ApiRequest {
}
-- | Examines HTTP request and translates it into user intent.
userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest
userApiRequest schema req reqBody
userApiRequest :: Schema -> Maybe QualifiedIdentifier -> Request -> RequestBody -> Either ApiRequestError ApiRequest
userApiRequest schema rootSpec req reqBody
| isTargetingProc && method `notElem` ["GET", "POST"] = Left ActionInappropriate
| topLevelRange == emptyRange = Left InvalidRange
| shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) witness payload
@@ -161,7 +161,9 @@ userApiRequest schema req reqBody
((<> ".") <$> "not":M.keys operators) ++
((<> "(") <$> M.keys ftsOperators)
isEmbedPath = T.isInfixOf "."
isTargetingProc = (== Just "rpc") $ listToMaybe path
isTargetingProc = case target of
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
@@ -188,7 +190,7 @@ userApiRequest schema req reqBody
topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges
action =
case method of
"GET" | target == TargetRoot -> ActionInspect
"GET" | target == TargetDefaultSpec -> ActionInspect
| isTargetingProc -> ActionInvoke{isReadOnly=True}
| otherwise -> ActionRead
@@ -201,12 +203,13 @@ userApiRequest schema req reqBody
"OPTIONS" -> ActionInfo
_ -> ActionInspect
target = case path of
[] -> TargetRoot
[table] -> TargetIdent
$ QualifiedIdentifier schema table
["rpc", proc] -> TargetProc
$ QualifiedIdentifier schema proc
other -> TargetUnknown other
[] -> case rootSpec of
Just rsQi -> TargetProc rsQi True
Nothing -> TargetDefaultSpec
[table] -> TargetIdent $ QualifiedIdentifier schema table
["rpc", proc] -> TargetProc (QualifiedIdentifier schema proc) False
other -> TargetUnknown other
shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionInvoke{isReadOnly=False}, ActionInvoke{isReadOnly=True}]
relevantPayload | shouldParsePayload = rightToMaybe payload
| otherwise = Nothing
+17 -17
View File
@@ -66,7 +66,7 @@ postgrest conf refDbStructure pool getTime worker =
Just dbStructure -> do
response <- do
-- Need to parse ?columns early because findProc needs it to solve overloaded functions
let apiReq = userApiRequest (configSchema conf) req body
let apiReq = userApiRequest (configSchema conf) (configRootSpec conf) req body
apiReqCols = (,) <$> apiReq <*> (pRequestColumns =<< iColumns <$> apiReq)
case apiReqCols of
Left err -> return . errorResponseFor $ err
@@ -78,7 +78,7 @@ postgrest conf refDbStructure pool getTime worker =
(Just RawJSON{}, Just cls) -> cls
_ -> S.empty
proc = case iTarget apiRequest of
TargetProc qi -> findProc qi cols (iPreferSingleObjectParameter apiRequest) $ dbProcs dbStructure
TargetProc qi _ -> findProc qi cols (iPreferSingleObjectParameter apiRequest) $ dbProcs dbStructure
_ -> Nothing
handleReq = runWithClaims conf eClaims (app dbStructure proc cols conf) apiRequest
txMode = transactionMode proc (iAction apiRequest)
@@ -103,7 +103,7 @@ 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) of
case responseContentTypeOrError (iAccepts apiRequest) (iAction apiRequest) (iTarget apiRequest) of
Left errorResponse -> return errorResponse
Right contentType ->
case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
@@ -259,7 +259,7 @@ app dbStructure proc cols conf apiRequest =
let acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
return $ responseLBS status200 [allOrigins, acceptH] ""
(ActionInvoke _, TargetProc qi, Just pJson) ->
(ActionInvoke _, TargetProc qi _, Just pJson) ->
let returnsScalar = case proc of
Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
_ -> False
@@ -290,7 +290,7 @@ app dbStructure proc cols conf apiRequest =
return . errorResponseFor . singularityError $ queryTotal
else return $ responseLBS status ([toHeader contentType, contentRange] ++ toHeaders hs) (toS body)
(ActionInspect, TargetRoot, Nothing) -> do
(ActionInspect, TargetDefaultSpec, Nothing) -> do
let host = configHost conf
port = toInteger $ configPort conf
proxy = pickProxy $ toS <$> configProxyUri conf
@@ -300,6 +300,7 @@ app dbStructure proc cols conf apiRequest =
toTableInfo :: [Table] -> [(Table, [Column], [Text])]
toTableInfo = map (\t -> let (s, tn) = (tableSchema t, tableName t) in (t, tableCols dbStructure s tn, tablePKCols dbStructure s tn))
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
@@ -329,19 +330,18 @@ app dbStructure proc cols conf apiRequest =
(,) <$> selectQuery
<*> (requestToQuery schema False . DbMutate <$> mutationDbRequest s t)
responseContentTypeOrError :: [ContentType] -> Action -> Either Response ContentType
responseContentTypeOrError accepts action = serves contentTypesForRequest accepts
responseContentTypeOrError :: [ContentType] -> Action -> Target -> Either Response ContentType
responseContentTypeOrError accepts action target = serves contentTypesForRequest accepts
where
contentTypesForRequest =
case action of
ActionRead -> [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
ActionCreate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
ActionUpdate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
ActionDelete -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
ActionInvoke _ -> [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
ActionInspect -> [CTOpenAPI, CTApplicationJSON]
ActionInfo -> [CTTextCSV]
ActionSingleUpsert -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
contentTypesForRequest = case action of
ActionRead -> [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
ActionCreate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
ActionUpdate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
ActionDelete -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
ActionInvoke _ -> [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream] ++ [CTOpenAPI | tpIsRootSpec target]
ActionInspect -> [CTOpenAPI, CTApplicationJSON]
ActionInfo -> [CTTextCSV]
ActionSingleUpsert -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]
serves sProduces cAccepts =
case mutuallyAgreeable sProduces cAccepts of
Nothing -> Left . errorResponseFor . ContentTypeError . map toMime $ cAccepts
+13 -3
View File
@@ -58,8 +58,10 @@ import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
import PostgREST.Error (ApiRequestError (..))
import PostgREST.Parsers (pRoleClaimKey)
import PostgREST.Types (JSPath, JSPathExp (..))
import Protolude hiding (hPutStrLn, intercalate, take, (<>))
import PostgREST.Types (JSPath, JSPathExp (..),
QualifiedIdentifier (..))
import Protolude hiding (concat, hPutStrLn, intercalate, null,
take, (<>))
-- | Config file settings for the server
@@ -84,6 +86,8 @@ data AppConfig = AppConfig {
, configSettings :: [(Text, Text)]
, configRoleClaimKey :: Either ApiRequestError JSPath
, configExtraSearchPath :: [Text]
, configRootSpec :: Maybe QualifiedIdentifier
}
configPoolTimeout' :: (Fractional a) => AppConfig -> a
@@ -142,12 +146,13 @@ readOptions = do
return appConf
where
dbSchema = reqString "db-schema"
parseConfig =
AppConfig
<$> reqString "db-uri"
<*> reqString "db-anon-role"
<*> optString "server-proxy-uri"
<*> reqString "db-schema"
<*> dbSchema
<*> (fromMaybe "!4" <$> optString "server-host")
<*> (fromMaybe 3000 <$> optInt "server-port")
<*> optString "server-unix-socket"
@@ -162,6 +167,7 @@ readOptions = do
<*> (fmap (fmap coerceText) <$> C.subassocs "app.settings" C.value)
<*> (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")
parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI)
parseJwtAudience k =
@@ -263,6 +269,10 @@ readOptions = do
|
|## extra schemas to add to the search_path of every request
|# db-extra-search-path = "extensions, util"
|
|## stored proc that overrides the root "/" spec
|## it must be inside the db-schema
|# root-spec = "stored_proc_name"
|]
pathParser :: Parser FilePath
+1 -2
View File
@@ -9,7 +9,6 @@ A query tree is built in case of resource embedding. By inferring the relationsh
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
module PostgREST.DbRequestBuilder (
@@ -59,7 +58,7 @@ readRequest maxRows allRels proc apiRequest =
let target = iTarget apiRequest in
case target of
(TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
(TargetProc (QualifiedIdentifier s pName) ) -> Just (s, tName)
(TargetProc (QualifiedIdentifier s pName) _ ) -> Just (s, tName)
where
tName = case pdReturnType <$> proc of
Just (SetOf (Composite qi)) -> qiName qi
+4
View File
@@ -179,6 +179,10 @@ data OrderTerm = OrderTerm {
, otNullOrder :: Maybe OrderNulls
} deriving (Show, Eq)
{-|
Represents a pg identifier with a prepended schema name "schema.table"
When qiSchema is "", the schema is defined by the pg search_path
-}
data QualifiedIdentifier = QualifiedIdentifier {
qiSchema :: Schema
, qiName :: TableName