From 54a2d7b9ee93a15a2bd435d1e1918dc05a8da002 Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Mon, 5 Jun 2023 15:33:21 -0500 Subject: [PATCH] refactor: cache the isolation level --- src/PostgREST/App.hs | 15 +++----- src/PostgREST/AppState.hs | 6 ++-- src/PostgREST/CLI.hs | 2 +- src/PostgREST/Config.hs | 15 ++++---- src/PostgREST/Config/Database.hs | 52 +++++++++++++++++++++------- src/PostgREST/SchemaCache.hs | 5 +-- src/PostgREST/SchemaCache/Routine.hs | 21 ++++++++--- test/spec/SpecHelper.hs | 1 + 8 files changed, 78 insertions(+), 39 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 8b834ee01b0..05e9ae6a9b9 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -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 diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index 28f9ee7e167..b608c940614 100644 --- a/src/PostgREST/AppState.hs +++ b/src/PostgREST/AppState.hs @@ -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 diff --git a/src/PostgREST/CLI.hs b/src/PostgREST/CLI.hs index f74c98a1192..5508d985dd8 100644 --- a/src/PostgREST/CLI.hs +++ b/src/PostgREST/CLI.hs @@ -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. diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index 9de11e9993f..1b79d0ff900 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -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)] diff --git a/src/PostgREST/Config/Database.hs b/src/PostgREST/Config/Database.hs index 711fdc6c65c..9356cc4a290 100644 --- a/src/PostgREST/Config/Database.hs +++ b/src/PostgREST/Config/Database.hs @@ -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 diff --git a/src/PostgREST/SchemaCache.hs b/src/PostgREST/SchemaCache.hs index be60b371fbb..8ec61e7d14a 100644 --- a/src/PostgREST/SchemaCache.hs +++ b/src/PostgREST/SchemaCache.hs @@ -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) diff --git a/src/PostgREST/SchemaCache/Routine.hs b/src/PostgREST/SchemaCache/Routine.hs index caae214d199..6a908cdd5a7 100644 --- a/src/PostgREST/SchemaCache/Routine.hs +++ b/src/PostgREST/SchemaCache/Routine.hs @@ -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,20 @@ data Routine = Function , pdReturnType :: RetType , pdVolatility :: FuncVolatility , pdHasVariadic :: Bool - , pdIsoLvl :: Maybe Text + , pdIsoLvl :: Maybe SQL.IsolationLevel } - deriving (Eq, Generic, JSON.ToJSON) + deriving (Eq, Generic) +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 diff --git a/test/spec/SpecHelper.hs b/test/spec/SpecHelper.hs index c90425eed12..c5b1a383759 100644 --- a/test/spec/SpecHelper.hs +++ b/test/spec/SpecHelper.hs @@ -113,6 +113,7 @@ baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in , configDbTxRollbackAll = True , configAdminServerPort = Nothing , configRoleSettings = mempty + , configRoleIsoLvl = mempty , configInternalSCSleep = Nothing }