refactor: Change SET LOCAL gucs to set_config

This commit is contained in:
steve-chavez
2020-12-07 20:09:18 -05:00
committed by Steve Chavez
parent 9254f119f6
commit 7069bb3c01
2 changed files with 32 additions and 36 deletions
+27 -27
View File
@@ -8,17 +8,16 @@ Description : Sets CORS policy. Also the PostgreSQL GUCs, role, search_path and
module PostgREST.Middleware where module PostgREST.Middleware where
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as BS
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import Data.Function (id) import Data.Function (id)
import qualified Data.HashMap.Strict as M import qualified Data.HashMap.Strict as M
import Data.List (lookup) import Data.List (lookup)
import Data.Scientific (FPFormat (..), import Data.Scientific (FPFormat (..),
formatScientific, formatScientific, isInteger)
isInteger) import qualified Data.Text as T
import qualified Data.Text as T import qualified Hasql.Transaction as H
import qualified Hasql.Transaction as H
import Network.HTTP.Types.Status (Status, status400, import Network.HTTP.Types.Status (Status, status400,
status500, statusCode) status500, statusCode)
import Network.Wai.Logger (showSockAddr) import Network.Wai.Logger (showSockAddr)
@@ -33,7 +32,7 @@ import Network.Wai.Middleware.Static (only, staticPolicy)
import PostgREST.ApiRequest (ApiRequest (..)) import PostgREST.ApiRequest (ApiRequest (..))
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
import PostgREST.QueryBuilder (setLocalQuery, setLocalSearchPathQuery) import PostgREST.QueryBuilder (setConfigLocal)
import PostgREST.Types (LogLevel (..)) import PostgREST.Types (LogLevel (..))
import Protolude hiding (head, toS) import Protolude hiding (head, toS)
import Protolude.Conv (toS) import Protolude.Conv (toS)
@@ -44,23 +43,24 @@ runPgLocals :: AppConfig -> M.HashMap Text JSON.Value ->
(ApiRequest -> H.Transaction Response) -> (ApiRequest -> H.Transaction Response) ->
ApiRequest -> H.Transaction Response ApiRequest -> H.Transaction Response
runPgLocals conf claims app req = do runPgLocals conf claims app req = do
H.sql $ toS . mconcat $ setSearchPathSql : setRoleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql H.sql . toS $ "select " <> T.intercalate ", " (searchPathSql : roleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql)
traverse_ H.sql preReq traverse_ H.sql preReqSql
app req app req
where where
methodSql = setLocalQuery mempty ("request.method", toS $ iMethod req) methodSql = setConfigLocal mempty ("request.method", toS $ iMethod req)
pathSql = setLocalQuery mempty ("request.path", toS $ iPath req) pathSql = setConfigLocal mempty ("request.path", toS $ iPath req)
headersSql = setLocalQuery "request.header." <$> iHeaders req headersSql = setConfigLocal "request.header." <$> iHeaders req
cookiesSql = setLocalQuery "request.cookie." <$> iCookies req cookiesSql = setConfigLocal "request.cookie." <$> iCookies req
claimsSql = setLocalQuery "request.jwt.claim." <$> [(c,unquoted v) | (c,v) <- M.toList claimsWithRole] claimsWithRole =
appSettingsSql = setLocalQuery mempty <$> configAppSettings conf let anon = JSON.String . toS $ configDbAnonRole conf in -- role claim defaults to anon if not specified in jwt
setRoleSql = maybeToList $ (\x -> M.union claims (M.singleton "role" anon)
setLocalQuery mempty ("role", unquoted x)) <$> M.lookup "role" claimsWithRole claimsSql = setConfigLocal "request.jwt.claim." <$> [(c,unquoted v) | (c,v) <- M.toList claimsWithRole]
setSearchPathSql = setLocalSearchPathQuery (iSchema req : configDbExtraSearchPath conf) roleSql = maybeToList $ (\x -> setConfigLocal mempty ("role", unquoted x)) <$> M.lookup "role" claimsWithRole
-- role claim defaults to anon if not specified in jwt appSettingsSql = setConfigLocal mempty <$> configAppSettings conf
claimsWithRole = M.union claims (M.singleton "role" anon) searchPathSql =
anon = JSON.String . toS $ configDbAnonRole conf let schemas = T.intercalate ", " (iSchema req : configDbExtraSearchPath conf) in
preReq = (\f -> "select " <> toS f <> "();") <$> configDbPreRequest conf setConfigLocal mempty ("search_path", schemas)
preReqSql = (\f -> "select " <> toS f <> "();") <$> configDbPreRequest conf
-- | Log in apache format. Only requests that have a status greater than minStatus are logged. -- | Log in apache format. Only requests that have a status greater than minStatus are logged.
-- | There's no way to filter logs in the apache format on wai-extra: https://hackage.haskell.org/package/wai-extra-3.0.29.2/docs/Network-Wai-Middleware-RequestLogger.html#t:OutputFormat. -- | There's no way to filter logs in the apache format on wai-extra: https://hackage.haskell.org/package/wai-extra-3.0.29.2/docs/Network-Wai-Middleware-RequestLogger.html#t:OutputFormat.
+5 -9
View File
@@ -16,8 +16,7 @@ module PostgREST.QueryBuilder (
, readRequestToCountQuery , readRequestToCountQuery
, requestToCallProcQuery , requestToCallProcQuery
, limitedQuery , limitedQuery
, setLocalQuery , setConfigLocal
, setLocalSearchPathQuery
) where ) where
import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as BS
@@ -173,10 +172,7 @@ readRequestToCountQuery (Node (Select{from=qi, where_=logicForest}, _) _) =
limitedQuery :: H.Snippet -> Maybe Integer -> H.Snippet limitedQuery :: H.Snippet -> Maybe Integer -> H.Snippet
limitedQuery query maxRows = query <> H.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows) limitedQuery query maxRows = query <> H.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows)
setLocalQuery :: Text -> (Text, Text) -> SqlQuery -- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.
setLocalQuery prefix (k, v) = setConfigLocal :: Text -> (Text, Text) -> Text
"SET LOCAL " <> pgFmtIdent (prefix <> k) <> " = " <> pgFmtLit v <> ";" setConfigLocal prefix (k, v) =
"set_config(" <> decodeUtf8 (pgFmtLit (prefix <> k)) <> ", " <> decodeUtf8 (pgFmtLit v) <> ", true)"
setLocalSearchPathQuery :: [Text] -> SqlQuery
setLocalSearchPathQuery vals =
"SET LOCAL search_path = " <> BS.intercalate ", " (pgFmtLit <$> vals) <> ";"