diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index 6e7f05056..38f607f5a 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -63,7 +63,7 @@ data Action = ActionCreate | ActionRead{isHead :: Bool} -- | The target db object of a user action data Target = TargetIdent QualifiedIdentifier | TargetProc{tpQi :: QualifiedIdentifier, tpIsRootSpec :: Bool} - | TargetDefaultSpec -- The default spec offered at root "/" + | TargetDefaultSpec{tdsSchema :: Schema} -- The default spec offered at root "/" | TargetUnknown [Text] deriving Eq @@ -120,7 +120,7 @@ data ApiRequest = ApiRequest { } -- | Examines HTTP request and translates it into user intent. -userApiRequest :: Schema -> Maybe QualifiedIdentifier -> Request -> RequestBody -> Either ApiRequestError ApiRequest +userApiRequest :: Schema -> Maybe Text -> Request -> RequestBody -> Either ApiRequestError ApiRequest userApiRequest schema rootSpec req reqBody | isTargetingProc && method `notElem` ["HEAD", "GET", "POST"] = Left ActionInappropriate | topLevelRange == emptyRange = Left InvalidRange @@ -178,6 +178,9 @@ userApiRequest schema rootSpec req reqBody isTargetingProc = case target of TargetProc _ _ -> True _ -> False + isTargetingDefaultSpec = case target of + TargetDefaultSpec _ -> True + _ -> False contentType = decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type" columns | action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] = toS <$> join (lookup "columns" qParams) @@ -209,12 +212,12 @@ userApiRequest schema rootSpec req reqBody case method of -- 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} + "HEAD" | isTargetingDefaultSpec -> ActionInspect{isHead=True} + | isTargetingProc -> ActionInvoke InvHead + | otherwise -> ActionRead{isHead=True} + "GET" | isTargetingDefaultSpec -> ActionInspect{isHead=False} + | isTargetingProc -> ActionInvoke InvGet + | otherwise -> ActionRead{isHead=False} "POST" -> if isTargetingProc then ActionInvoke InvPost else ActionCreate @@ -225,8 +228,8 @@ userApiRequest schema rootSpec req reqBody _ -> ActionInspect{isHead=False} target = case path of [] -> case rootSpec of - Just rsQi -> TargetProc rsQi True - Nothing -> TargetDefaultSpec + Just pName -> TargetProc (QualifiedIdentifier schema pName) True + Nothing -> TargetDefaultSpec schema [table] -> TargetIdent $ QualifiedIdentifier schema table ["rpc", proc] -> TargetProc (QualifiedIdentifier schema proc) False other -> TargetUnknown other diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 4c67c3fbc..e4e0a99b6 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -125,8 +125,8 @@ app dbStructure proc cols conf apiRequest = Right contentType -> case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of - (ActionRead headersOnly, TargetIdent (QualifiedIdentifier _ tName), Nothing) -> - case readSqlParts tName of + (ActionRead headersOnly, TargetIdent (QualifiedIdentifier tSchema tName), Nothing) -> + case readSqlParts tSchema tName of Left errorResponse -> return errorResponse Right (q, cq, bField) -> do let cQuery = if estimatedCount @@ -281,9 +281,9 @@ app dbStructure proc cols conf apiRequest = allOrigins = ("Access-Control-Allow-Origin", "*") :: Header in return $ responseLBS status200 [allOrigins, allowH] mempty - (ActionInvoke invMethod, TargetProc qi@(QualifiedIdentifier _ pName) _, Just pJson) -> + (ActionInvoke invMethod, TargetProc qi@(QualifiedIdentifier tSchema pName) _, Just pJson) -> let tName = fromMaybe pName $ procTableName =<< proc in - case readSqlParts tName of + case readSqlParts tSchema tName of Left errorResponse -> return errorResponse Right (q, cq, bField) -> do let @@ -306,7 +306,7 @@ app dbStructure proc cols conf apiRequest = return $ responseLBS status ([toHeader contentType, contentRange] ++ toHeaders hs) (if invMethod == InvHead then mempty else toS body) - (ActionInspect headersOnly, TargetDefaultSpec, Nothing) -> do + (ActionInspect headersOnly, TargetDefaultSpec tSchema, Nothing) -> do let host = configHost conf port = toInteger $ configPort conf proxy = pickProxy $ toS <$> configProxyUri conf @@ -317,14 +317,16 @@ app dbStructure proc cols conf apiRequest = 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 + body <- encodeApi <$> + H.statement tSchema accessibleTables <*> + H.statement tSchema schemaDescription <*> + H.statement tSchema accessibleProcs return $ responseLBS status200 [toHeader CTOpenAPI] (if headersOnly then mempty else toS body) _ -> return notFound where notFound = responseLBS status404 [] "" - schema = toS $ configSchema conf maxRows = configMaxRows conf exactCount = iPreferCount apiRequest == Just ExactCount estimatedCount = iPreferCount apiRequest == Just EstimatedCount @@ -334,9 +336,9 @@ app dbStructure proc cols conf apiRequest = returnsScalar = maybe False procReturnsScalar proc selectQuery = readRequestToQuery False - readSqlParts tableName = + readSqlParts s t = let - readReq = readRequest schema tableName maxRows (dbRelations dbStructure) apiRequest + readReq = readRequest s t maxRows (dbRelations dbStructure) apiRequest in (,,) <$> (selectQuery <$> readReq) <*> diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index 3544a9ce6..023e111e2 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -58,8 +58,7 @@ import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>)) import PostgREST.Error (ApiRequestError (..)) import PostgREST.Parsers (pRoleClaimKey) -import PostgREST.Types (JSPath, JSPathExp (..), - QualifiedIdentifier (..)) +import PostgREST.Types (JSPath, JSPathExp (..)) import Protolude hiding (concat, hPutStrLn, intercalate, null, take, (<>)) @@ -87,7 +86,7 @@ data AppConfig = AppConfig { , configRoleClaimKey :: Either ApiRequestError JSPath , configExtraSearchPath :: [Text] - , configRootSpec :: Maybe QualifiedIdentifier + , configRootSpec :: Maybe Text , configRawMediaTypes :: [B.ByteString] } @@ -147,13 +146,12 @@ readOptions = do return appConf where - dbSchema = reqString "db-schema" parseConfig = AppConfig <$> reqString "db-uri" <*> reqString "db-anon-role" <*> optString "server-proxy-uri" - <*> dbSchema + <*> reqString "db-schema" <*> (fromMaybe "!4" <$> optString "server-host") <*> (fromMaybe 3000 <$> optInt "server-port") <*> optString "server-unix-socket" @@ -168,7 +166,7 @@ readOptions = do <*> (fmap (fmap coerceText) <$> C.subassocs "app.settings" C.value) <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> optValue "role-claim-key") <*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path") - <*> ((\x y -> QualifiedIdentifier x <$> y) <$> dbSchema <*> optString "root-spec") + <*> optString "root-spec" <*> (maybe [] (fmap encodeUtf8 . splitOnCommas) <$> optValue "raw-media-types") parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI) diff --git a/src/PostgREST/DbRequestBuilder.hs b/src/PostgREST/DbRequestBuilder.hs index f0e4a9418..1aeeb8dc5 100644 --- a/src/PostgREST/DbRequestBuilder.hs +++ b/src/PostgREST/DbRequestBuilder.hs @@ -94,10 +94,10 @@ treeRestrictRange maxRows request = pure $ nodeRestrictRange maxRows <$> request nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i) -augumentRequestWithJoin :: Schema -> [Relation] -> ReadRequest -> Either ApiRequestError ReadRequest +augumentRequestWithJoin :: Schema -> [Relation] -> ReadRequest -> Either ApiRequestError ReadRequest augumentRequestWithJoin schema allRels request = addRelations schema allRels Nothing request - >>= addJoinConditions schema Nothing + >>= addJoinConditions Nothing addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest addRelations schema allRelations parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, relationDetail, depth)) forest) = @@ -199,8 +199,8 @@ findRelation schema allRelations nodeTableName parentNodeTableName relationDetai ) allRelations -- previousAlias is only used for the case of self joins -addJoinConditions :: Schema -> Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest -addJoinConditions schema previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_, relation, _, _, depth)) forest) = +addJoinConditions :: Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest +addJoinConditions previousAlias (Node node@(query@Select{from=tbl}, nodeProps@(_, relation, _, _, depth)) forest) = case relation of Just Relation{relType=Root} -> Node node <$> updatedForest -- this is the root node Just rel@Relation{relType=Parent} -> Node (augmentQuery rel, nodeProps) <$> updatedForest @@ -220,7 +220,7 @@ addJoinConditions schema previousAlias (Node node@(query@Select{from=tbl}, nodeP (\jc rq@Select{joinConditions=jcs} -> rq{joinConditions=jc:jcs}) query{fromAlias=newAlias} (getJoinConditions previousAlias newAlias rel) - updatedForest = mapM (addJoinConditions schema newAlias) forest + updatedForest = mapM (addJoinConditions newAlias) forest -- previousAlias and newAlias are used in the case of self joins getJoinConditions :: Maybe Alias -> Maybe Alias -> Relation -> [JoinCondition] diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index a02cc8e9c..e57efc8d1 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -23,7 +23,7 @@ import Test.Hspec.Wai import Text.Heredoc import PostgREST.Config (AppConfig (..)) -import PostgREST.Types (JSPathExp (..), QualifiedIdentifier (..)) +import PostgREST.Types (JSPathExp (..)) import Protolude matchContentTypeJson :: MatchHeader @@ -131,7 +131,7 @@ testCfgExtraSearchPath :: Text -> AppConfig testCfgExtraSearchPath testDbConn = (testCfg testDbConn) { configExtraSearchPath = ["public", "extensions"] } testCfgRootSpec :: Text -> AppConfig -testCfgRootSpec testDbConn = (testCfg testDbConn) { configRootSpec = Just $ QualifiedIdentifier "test" "root"} +testCfgRootSpec testDbConn = (testCfg testDbConn) { configRootSpec = Just "root"} testCfgHtmlRawOutput :: Text -> AppConfig testCfgHtmlRawOutput testDbConn = (testCfg testDbConn) { configRawMediaTypes = ["text/html"] }