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:
+15
-12
@@ -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
@@ -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
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user