diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index 3b63078ee..04dd19e31 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -51,9 +51,11 @@ import Numeric (readOct, showOct) import System.Environment (getEnvironment) import System.Posix.Types (FileMode) -import PostgREST.Config.JSPath (JSPath, JSPathExp (..), pRoleClaimKey) -import PostgREST.Config.Proxy (Proxy (..), isMalformedProxyUri, - toURI) +import PostgREST.Config.JSPath (JSPath, JSPathExp (..), + pRoleClaimKey) +import PostgREST.Config.Proxy (Proxy (..), + isMalformedProxyUri, toURI) +import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, toQi) import Protolude hiding (Proxy, toList, toS) import Protolude.Conv (toS) @@ -68,7 +70,7 @@ data AppConfig = AppConfig , configDbMaxRows :: Maybe Integer , configDbPoolSize :: Int , configDbPoolTimeout :: NominalDiffTime - , configDbPreRequest :: Maybe Text + , configDbPreRequest :: Maybe QualifiedIdentifier , configDbPreparedStatements :: Bool , configDbRootSpec :: Maybe Text , configDbSchemas :: NonEmpty Text @@ -113,7 +115,7 @@ toText conf = ,("db-max-rows", maybe "\"\"" show . configDbMaxRows) ,("db-pool", show . configDbPoolSize) ,("db-pool-timeout", show . floor . configDbPoolTimeout) - ,("db-pre-request", q . fromMaybe mempty . configDbPreRequest) + ,("db-pre-request", q . maybe mempty show . configDbPreRequest) ,("db-prepared-statements", T.toLower . show . configDbPreparedStatements) ,("db-root-spec", q . fromMaybe mempty . configDbRootSpec) ,("db-schemas", q . T.intercalate "," . toList . configDbSchemas) @@ -197,8 +199,8 @@ parser optPath env dbSettings = (optInt "max-rows") <*> (fromMaybe 10 <$> optInt "db-pool") <*> (fromIntegral . fromMaybe 10 <$> optInt "db-pool-timeout") - <*> optWithAlias (optString "db-pre-request") - (optString "pre-request") + <*> (fmap toQi <$> optWithAlias (optString "db-pre-request") + (optString "pre-request")) <*> (fromMaybe True <$> optBool "db-prepared-statements") <*> optWithAlias (optString "db-root-spec") (optString "root-spec") diff --git a/src/PostgREST/DbStructure/Identifiers.hs b/src/PostgREST/DbStructure/Identifiers.hs index f20d7e812..40b85d6fe 100644 --- a/src/PostgREST/DbStructure/Identifiers.hs +++ b/src/PostgREST/DbStructure/Identifiers.hs @@ -6,9 +6,12 @@ module PostgREST.DbStructure.Identifiers , Schema , TableName , FieldName + , toQi ) where import qualified Data.Aeson as JSON +import qualified Data.Text as T +import qualified GHC.Show import Protolude @@ -23,6 +26,17 @@ data QualifiedIdentifier = QualifiedIdentifier instance Hashable QualifiedIdentifier +instance Show QualifiedIdentifier where + show (QualifiedIdentifier s i) = + (if T.null s then mempty else toS s <> ".") <> toS i + +-- TODO: Handle a case where the QI comes like this: "my.fav.schema"."my.identifier" +-- Right now it only handles the schema.identifier case +toQi :: Text -> QualifiedIdentifier +toQi txt = case T.drop 1 <$> T.breakOn "." txt of + (i, "") -> QualifiedIdentifier mempty i + (s, i) -> QualifiedIdentifier s i + type Schema = Text type TableName = Text type FieldName = Text diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs index a74196233..57d6bcd8b 100644 --- a/src/PostgREST/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -42,7 +42,7 @@ import System.Log.FastLogger (toLogStr) import PostgREST.Config (AppConfig (..), LogLevel (..)) import PostgREST.Error (Error, errorResponseFor) import PostgREST.GucHeader (addHeadersIfNotIncluded) -import PostgREST.Query.SqlFragment (intercalateSnippet, +import PostgREST.Query.SqlFragment (fromQi, intercalateSnippet, unknownLiteral) import PostgREST.Request.ApiRequest (ApiRequest (..)) @@ -75,7 +75,7 @@ runPgLocals conf claims app req = do searchPathSql = let schemas = T.intercalate ", " (iSchema req : configDbExtraSearchPath conf) in setConfigLocal mempty ("search_path", schemas) - preReqSql = (\f -> "select " <> toS f <> "();") <$> configDbPreRequest conf + preReqSql = (\f -> "select " <> fromQi f <> "();") <$> configDbPreRequest conf -- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL. setConfigLocal :: Text -> (Text, Text) -> H.Snippet diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index 2dff2bbd3..26def5fa9 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -135,6 +135,7 @@ pgFmtLit x = then "E" <> slashed else slashed +-- TODO: refactor by following https://github.com/PostgREST/postgrest/pull/1631#issuecomment-711070833 pgFmtIdent :: Text -> SqlFragment pgFmtIdent x = encodeUtf8 $ "\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "\"" diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index fbbe53f4b..a4d21534f 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -22,10 +22,12 @@ import Test.Hspec import Test.Hspec.Wai import Text.Heredoc -import PostgREST.Config (AppConfig (..), JSPathExp (..), - LogLevel (..), parseSecret) -import Protolude hiding (toS) -import Protolude.Conv (toS) +import PostgREST.Config (AppConfig (..), + JSPathExp (..), + LogLevel (..), parseSecret) +import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..)) +import Protolude hiding (toS) +import Protolude.Conv (toS) matchContentTypeJson :: MatchHeader matchContentTypeJson = "Content-Type" <:> "application/json; charset=utf-8" @@ -79,7 +81,7 @@ _baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in , configDbMaxRows = Nothing , configDbPoolSize = 10 , configDbPoolTimeout = 10 - , configDbPreRequest = Just "test.switch_role" + , configDbPreRequest = Just $ QualifiedIdentifier "test" "switch_role" , configDbPreparedStatements = True , configDbRootSpec = Nothing , configDbSchemas = fromList ["test"] @@ -169,7 +171,7 @@ testCfgHtmlRawOutput :: Text -> AppConfig testCfgHtmlRawOutput testDbConn = (testCfg testDbConn) { configRawMediaTypes = ["text/html"] } testCfgResponseHeaders :: Text -> AppConfig -testCfgResponseHeaders testDbConn = (testCfg testDbConn) { configDbPreRequest = Just "custom_headers" } +testCfgResponseHeaders testDbConn = (testCfg testDbConn) { configDbPreRequest = Just $ QualifiedIdentifier mempty "custom_headers" } testMultipleSchemaCfg :: Text -> AppConfig testMultipleSchemaCfg testDbConn = (testCfg testDbConn) { configDbSchemas = fromList ["v1", "v2"] }