From e409216ef49680cc48cd99979adf6b30971ac7d6 Mon Sep 17 00:00:00 2001
From: steve-chavez <stevechavezast@gmail.com>
Date: Sat, 3 Apr 2021 13:11:47 -0500
Subject: [PATCH] Correct db-root-spec to accept a schema

---
 src/PostgREST/ApiRequest.hs | 10 +++++-----
 src/PostgREST/Config.hs     |  8 ++++----
 test/SpecHelper.hs          |  2 +-
 3 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs
index 2b969e09d11..e015b195ca0 100644
--- a/src/PostgREST/ApiRequest.hs
+++ b/src/PostgREST/ApiRequest.hs
@@ -131,7 +131,7 @@ data ApiRequest = ApiRequest {
   }
 
 -- | Examines HTTP request and translates it into user intent.
-userApiRequest :: NonEmpty Schema -> Maybe Text -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest
+userApiRequest :: NonEmpty Schema -> Maybe QualifiedIdentifier -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest
 userApiRequest confSchemas rootSpec dbStructure req reqBody
   | isJust profile && fromJust profile `notElem` confSchemas = Left $ UnacceptableSchema $ toList confSchemas
   | isTargetingProc && method `notElem` ["HEAD", "GET", "POST"] = Left ActionInappropriate
@@ -275,14 +275,14 @@ userApiRequest confSchemas rootSpec dbStructure req reqBody
   schema = fromMaybe defaultSchema profile
   target =
     let
-      callFindProc proc = findProc (QualifiedIdentifier schema proc) payloadColumns (hasPrefer (show SingleObject)) $ dbProcs dbStructure
+      callFindProc procSch procNam = findProc (QualifiedIdentifier procSch procNam) payloadColumns (hasPrefer (show SingleObject)) $ dbProcs dbStructure
     in
     case path of
       []             -> case rootSpec of
-                        Just pName -> TargetProc (callFindProc pName) True
-                        Nothing    -> TargetDefaultSpec schema
+                          Just (QualifiedIdentifier pSch pName) -> TargetProc (callFindProc (if pSch == mempty then schema else pSch) pName) True
+                          Nothing                               -> TargetDefaultSpec schema
       [table]        -> TargetIdent $ QualifiedIdentifier schema table
-      ["rpc", pName] -> TargetProc (callFindProc pName) False
+      ["rpc", pName] -> TargetProc (callFindProc schema pName) False
       _              -> TargetUnknown
 
   shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionInvoke InvPost]
diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs
index bb5e02c31e0..c40ededc380 100644
--- a/src/PostgREST/Config.hs
+++ b/src/PostgREST/Config.hs
@@ -104,7 +104,7 @@ data AppConfig = AppConfig {
   , configDbPoolTimeout         :: Int
   , configDbPreRequest          :: Maybe QualifiedIdentifier
   , configDbPreparedStatements  :: Bool
-  , configDbRootSpec            :: Maybe Text
+  , configDbRootSpec            :: Maybe QualifiedIdentifier
   , configDbSchemas             :: NonEmpty Text
   , configDbConfig              :: Bool
   , configDbTxAllowOverride     :: Bool
@@ -287,7 +287,7 @@ dumpAppConfig conf =
       ,("db-pool-timeout",               show . configDbPoolTimeout)
       ,("db-pre-request",            q . maybe mempty show . configDbPreRequest)
       ,("db-prepared-statements",        toLower . show . configDbPreparedStatements)
-      ,("db-root-spec",              q . fromMaybe mempty . configDbRootSpec)
+      ,("db-root-spec",              q . maybe mempty show . configDbRootSpec)
       ,("db-schemas",                q . intercalate "," . toList . configDbSchemas)
       ,("db-config",                 q . toLower . show . configDbConfig)
       ,("db-tx-end",                 q . showTxEnd)
@@ -365,8 +365,8 @@ readAppConfig dbSettings env optPath dbUriFile secretFile = do
         <*> (fmap toQi <$> optWithAlias (optString "db-pre-request")
                                         (optString "pre-request"))
         <*> (fromMaybe True <$> optBool "db-prepared-statements")
-        <*> optWithAlias (optString "db-root-spec")
-                         (optString "root-spec")
+        <*> (fmap toQi <$> optWithAlias (optString "db-root-spec")
+                                        (optString "root-spec"))
         <*> (fromList . splitOnCommas <$> reqWithAlias (optValue "db-schemas")
                                                        (optValue "db-schema")
                                                        "missing key: either db-schemas or db-schema must be set")
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index 907453cfee3..5ef0e8bea6e 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -163,7 +163,7 @@ testCfgExtraSearchPath :: Text -> AppConfig
 testCfgExtraSearchPath testDbConn = (testCfg testDbConn) { configDbExtraSearchPath = ["public", "extensions"] }
 
 testCfgRootSpec :: Text -> AppConfig
-testCfgRootSpec testDbConn = (testCfg testDbConn) { configDbRootSpec = Just "root"}
+testCfgRootSpec testDbConn = (testCfg testDbConn) { configDbRootSpec = Just $ QualifiedIdentifier mempty "root"}
 
 testCfgHtmlRawOutput :: Text -> AppConfig
 testCfgHtmlRawOutput testDbConn = (testCfg testDbConn) { configRawMediaTypes = ["text/html"] }