jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: cache the isolation level

Browse Source
This commit is contained in:
steve-chavez
2023-06-06 14:41:37 -05:00
committed by Steve Chavez
parent 9a19dff83e
commit 8d1961ce07
8 changed files with 79 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/App.hs
+4 -11
View File
@@ -9,7 +9,6 @@ Some of its functionality includes:
- Producing HTTP Headers according to RFCs.
- Content Negotiation
-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.App
( SignalHandlerInstaller
@@ -153,23 +152,17 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@
Response.optionalRollback conf apiRequest $
handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache
runDbHandler :: AppState.AppState -> Maybe Text -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
runDbHandler :: AppState.AppState -> SQL.IsolationLevel -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
runDbHandler appState isoLvl mode authenticated prepared handler = do
dbResp <- lift $ do
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction
AppState.usePool appState . transaction (toIsolationLevel isoLvl) mode $ runExceptT handler
AppState.usePool appState . transaction isoLvl mode $ runExceptT handler
resp <-
liftEither . mapLeft Error.PgErr $
mapLeft (Error.PgError authenticated) dbResp
liftEither resp
where
toIsolationLevel = \case
Nothing -> SQL.ReadCommitted
Just "repeatable read" -> SQL.RepeatableRead
Just "serializable" -> SQL.Serializable
_ -> SQL.ReadCommitted
handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> PgVersion -> ApiRequest -> SchemaCache -> Handler IO Wai.Response
handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache =
@@ -201,7 +194,7 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A
(ActionInvoke invMethod, TargetProc identifier _) -> do
cPlan <- liftEither $ Plan.callReadPlan identifier conf sCache apiReq invMethod
resultSet <- runQuery (roleIsoLvl <|> pdIsoLvl (Plan.crProc cPlan))(Plan.crTxMode cPlan) $ Query.invokeQuery (Plan.crProc cPlan) cPlan apiReq conf pgVer
resultSet <- runQuery (fromMaybe roleIsoLvl $ pdIsoLvl (Plan.crProc cPlan))(Plan.crTxMode cPlan) $ Query.invokeQuery (Plan.crProc cPlan) cPlan apiReq conf pgVer
return $ Response.invokeResponse invMethod (Plan.crProc cPlan) apiReq resultSet
(ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
@@ -224,7 +217,7 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A
throwError $ Error.ApiRequestError ApiRequestTypes.NotFound
where
roleSettings = fromMaybe mempty (HM.lookup authRole $ configRoleSettings conf)
roleIsoLvl = decodeUtf8 <$> HM.lookup "default_transaction_isolation" roleSettings
roleIsoLvl = HM.findWithDefault SQL.ReadCommitted authRole $ configRoleIsoLvl conf
runQuery isoLvl mode query =
runDbHandler appState isoLvl mode authenticated prepared $ do
Query.setPgLocals conf authClaims authRole (HM.toList roleSettings) apiReq pgVer
src/PostgREST/AppState.hs
+3 -3
View File
@@ -373,18 +373,18 @@ reReadConfig startingUp appState = do
Right x -> pure x
else
pure mempty
roleSettings <-
(roleSettings, roleIsolationLvl) <-
if configDbConfig then do
rSettings <- usePool appState $ queryRoleSettings configDbPreparedStatements
case rSettings of
Left e -> do
logWithZTime appState "An error ocurred when trying to query the role settings"
logPgrstError appState e
pure mempty
pure (mempty, mempty)
Right x -> pure x
else
pure mempty
readAppConfig dbSettings configFilePath (Just configDbUri) roleSettings >>= \case
readAppConfig dbSettings configFilePath (Just configDbUri) roleSettings roleIsolationLvl >>= \case
Left err ->
if startingUp then
panic err -- die on invalid config if the program is starting up
src/PostgREST/CLI.hs
+1 -1
View File
@@ -32,7 +32,7 @@ import Protolude hiding (hPutStrLn)
main :: App.SignalHandlerInstaller -> Maybe App.SocketRunner -> CLI -> IO ()
main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do
conf@AppConfig{..} <-
either panic identity <$> Config.readAppConfig mempty cliPath Nothing mempty
either panic identity <$> Config.readAppConfig mempty cliPath Nothing mempty mempty
-- Per https://github.com/PostgREST/postgrest/issues/268, we want to
-- explicitly close the connections to PostgreSQL on shutdown.
src/PostgREST/Config.hs
+9 -6
View File
@@ -51,7 +51,8 @@ import Numeric (readOct, showOct)
import System.Environment (getEnvironment)
import System.Posix.Types (FileMode)
import PostgREST.Config.Database (RoleSettings)
import PostgREST.Config.Database (RoleIsolationLvl,
RoleSettings)
import PostgREST.Config.JSPath (JSPath, JSPathExp (..),
dumpJSPath, pRoleClaimKey)
import PostgREST.Config.Proxy (Proxy (..),
@@ -103,6 +104,7 @@ data AppConfig = AppConfig
, configServerUnixSocketMode :: FileMode
, configAdminServerPort :: Maybe Int
, configRoleSettings :: RoleSettings
, configRoleIsoLvl :: RoleIsolationLvl
, configInternalSCSleep :: Maybe Int32
}
@@ -198,13 +200,13 @@ instance JustIfMaybe a (Maybe a) where
-- | Reads and parses the config and overrides its parameters from env vars,
-- files or db settings.
readAppConfig :: [(Text, Text)] -> Maybe FilePath -> Maybe Text -> RoleSettings -> IO (Either Text AppConfig)
readAppConfig dbSettings optPath prevDbUri roleSettings = do
readAppConfig :: [(Text, Text)] -> Maybe FilePath -> Maybe Text -> RoleSettings -> RoleIsolationLvl -> IO (Either Text AppConfig)
readAppConfig dbSettings optPath prevDbUri roleSettings roleIsolationLvl = do
env <- readPGRSTEnvironment
-- if no filename provided, start with an empty map to read config from environment
conf <- maybe (return $ Right M.empty) loadConfig optPath
case C.runParser (parser optPath env dbSettings roleSettings) =<< mapLeft show conf of
case C.runParser (parser optPath env dbSettings roleSettings roleIsolationLvl) =<< mapLeft show conf of
Left err ->
return . Left $ "Error in config " <> err
Right parsedConfig ->
@@ -219,8 +221,8 @@ readAppConfig dbSettings optPath prevDbUri roleSettings = do
decodeJWKS <$>
(decodeSecret =<< readSecretFile =<< readDbUriFile prevDbUri parsedConfig)
parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> RoleSettings -> C.Parser C.Config AppConfig
parser optPath env dbSettings roleSettings =
parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> RoleSettings -> RoleIsolationLvl -> C.Parser C.Config AppConfig
parser optPath env dbSettings roleSettings roleIsolationLvl =
AppConfig
<$> parseAppSettings "app.settings"
<*> (fmap encodeUtf8 <$> optString "db-anon-role")
@@ -268,6 +270,7 @@ parser optPath env dbSettings roleSettings =
<*> parseSocketFileMode "server-unix-socket-mode"
<*> optInt "admin-server-port"
<*> pure roleSettings
<*> pure roleIsolationLvl
<*> optInt "internal-schema-cache-sleep"
where
parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)]
src/PostgREST/Config/Database.hs
+40 -12
View File
@@ -6,6 +6,8 @@ module PostgREST.Config.Database
, queryRoleSettings
, queryPgVersion
, RoleSettings
, RoleIsolationLvl
, toIsolationLevel
) where
import Control.Arrow ((***))
@@ -25,7 +27,14 @@ import Text.InterpolatedString.Perl6 (q, qc)
import Protolude
type RoleSettings = (HM.HashMap ByteString (HM.HashMap ByteString ByteString))
type RoleSettings = (HM.HashMap ByteString (HM.HashMap ByteString ByteString))
type RoleIsolationLvl = HM.HashMap ByteString SQL.IsolationLevel
toIsolationLevel :: (Eq a, IsString a) => a -> SQL.IsolationLevel
toIsolationLevel a = case a of
"repeatable read" -> SQL.RepeatableRead
"serializable" -> SQL.Serializable
_ -> SQL.ReadCommitted
prefix :: Text
prefix = "pgrst."
@@ -117,13 +126,10 @@ queryDbSettings preConfFunc prepared =
|]::Text
decodeSettings = HD.rowList $ (,) <$> column HD.text <*> column HD.text
queryRoleSettings :: Bool -> Session RoleSettings
queryRoleSettings :: Bool -> Session (RoleSettings, RoleIsolationLvl)
queryRoleSettings prepared =
let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty $ roleSettingsStatement prepared
roleSettingsStatement :: Bool -> SQL.Statement () RoleSettings
roleSettingsStatement = SQL.Statement sql HE.noParams decodeRoleSettings
transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty $ SQL.Statement sql HE.noParams (processRows <$> rows) prepared
where
sql = [q|
with
@@ -139,18 +145,40 @@ roleSettingsStatement = SQL.Statement sql HE.noParams decodeRoleSettings
substr(setting, 1, strpos(setting, '=') - 1) as key,
lower(substr(setting, strpos(setting, '=') + 1)) as value
FROM role_setting
),
iso_setting AS (
SELECT rolname, value
FROM kv_settings
WHERE key = 'default_transaction_isolation'
)
select rolname, array_agg(row(key, value))
from kv_settings
group by rolname;
select
kv.rolname,
i.value as iso_lvl,
array_agg(row(kv.key, kv.value)) filter (where key <> 'default_transation_isolation') as role_settings
from kv_settings kv
left join iso_setting i on i.rolname = kv.rolname
group by kv.rolname, i.value;
|]
decodeRoleSettings = HM.fromList . map (bimap encodeUtf8 (HM.fromList . ((encodeUtf8 *** encodeUtf8) <$>))) <$> HD.rowList aRow
aRow :: HD.Row (Text, [(Text, Text)])
aRow = (,) <$> column HD.text <*> compositeArrayColumn ((,) <$> compositeField HD.text <*> compositeField HD.text)
processRows :: [(Text, Maybe Text, [(Text, Text)])] -> (RoleSettings, RoleIsolationLvl)
processRows rs =
let
rowsWRoleSettings = [ (x, z) | (x, _, z) <- rs ]
rowsWIsolation = [ (x, y) | (x, Just y, _) <- rs ]
in
( HM.fromList $ bimap encodeUtf8 (HM.fromList . ((encodeUtf8 *** encodeUtf8) <$>)) <$> rowsWRoleSettings
, HM.fromList $ (encodeUtf8 *** toIsolationLevel) <$> rowsWIsolation
)
rows :: HD.Result [(Text, Maybe Text, [(Text, Text)])]
rows = HD.rowList $ (,,) <$> column HD.text <*> nullableColumn HD.text <*> compositeArrayColumn ((,) <$> compositeField HD.text <*> compositeField HD.text)
column :: HD.Value a -> HD.Row a
column = HD.column . HD.nonNullable
nullableColumn :: HD.Value a -> HD.Row (Maybe a)
nullableColumn = HD.column . HD.nullable
compositeField :: HD.Value a -> HD.Composite a
compositeField = HD.field . HD.nonNullable
src/PostgREST/SchemaCache.hs
+3 -2
View File
@@ -41,7 +41,8 @@ import Contravariant.Extras (contrazip2)
import Text.InterpolatedString.Perl6 (q)
import PostgREST.Config (AppConfig (..))
import PostgREST.Config.Database (pgVersionStatement)
import PostgREST.Config.Database (pgVersionStatement,
toIsolationLevel)
import PostgREST.Config.PgVersion (PgVersion, pgVersion100,
pgVersion110, pgVersion120)
import PostgREST.SchemaCache.Identifiers (AccessSet, FieldName,
@@ -259,7 +260,7 @@ decodeFuncs =
<*> column HD.bool)
<*> (parseVolatility <$> column HD.char)
<*> column HD.bool
<*> nullableColumn HD.text
<*> nullableColumn (toIsolationLevel <$> HD.text)
addKey :: Routine -> (QualifiedIdentifier, Routine)
addKey pd = (QualifiedIdentifier (pdSchema pd) (pdName pd), pd)
src/PostgREST/SchemaCache/Routine.hs
+18 -4
View File
@@ -16,8 +16,10 @@ module PostgREST.SchemaCache.Routine
, funcReturnsCompositeAlias
) where
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HM
import Data.Aeson ((.=))
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as HM
import qualified Hasql.Transaction.Sessions as SQL
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..),
Schema, TableName)
@@ -48,9 +50,21 @@ data Routine = Function
, pdReturnType :: RetType
, pdVolatility :: FuncVolatility
, pdHasVariadic :: Bool
, pdIsoLvl :: Maybe Text
, pdIsoLvl :: Maybe SQL.IsolationLevel
}
deriving (Eq, Generic, JSON.ToJSON)
deriving (Eq, Generic)
-- need to define JSON manually bc SQL.IsolationLevel doesn't have a JSON instance(and we can't define one for that type without getting a compiler error)
instance JSON.ToJSON Routine where
toJSON (Function sch nam desc params ret vol hasVar _) = JSON.object
[
"pdSchema" .= sch
, "pdName" .= nam
, "pdDescription" .= desc
, "pdParams" .= JSON.toJSON params
, "pdReturnType" .= JSON.toJSON ret
, "pdVolatility" .= JSON.toJSON vol
, "pdHasVariadic" .= JSON.toJSON hasVar
]
data RoutineParam = RoutineParam
{ ppName :: Text
test/spec/SpecHelper.hs
+1
View File
@@ -113,6 +113,7 @@ baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in
, configDbTxRollbackAll = True
, configAdminServerPort = Nothing
, configRoleSettings = mempty
, configRoleIsoLvl = mempty
, configInternalSCSleep = Nothing
}