diff --git a/src/PostgREST/Admin.hs b/src/PostgREST/Admin.hs index 70df961ff..af1902e85 100644 --- a/src/PostgREST/Admin.hs +++ b/src/PostgREST/Admin.hs @@ -26,23 +26,23 @@ import qualified PostgREST.Config as Config import Protolude -runAdmin :: AppConfig -> AppState -> Warp.Settings -> (Observation -> IO ()) -> IO () -runAdmin conf@AppConfig{configAdminServerPort} appState settings observer = +runAdmin :: AppConfig -> AppState -> Warp.Settings -> IO () +runAdmin conf@AppConfig{configAdminServerPort, configObserver=observer} appState settings = whenJust (AppState.getSocketAdmin appState) $ \adminSocket -> do observer $ AdminStartObs configAdminServerPort void . forkIO $ Warp.runSettingsSocket settings adminSocket adminApp where - adminApp = admin appState conf observer + adminApp = admin appState conf -- | PostgREST admin application -admin :: AppState.AppState -> AppConfig -> (Observation -> IO ()) -> Wai.Application -admin appState appConfig observer req respond = do +admin :: AppState.AppState -> AppConfig -> Wai.Application +admin appState appConfig req respond = do isMainAppReachable <- isRight <$> reachMainApp (AppState.getSocketREST appState) isSchemaCacheLoaded <- AppState.getSchemaCacheLoaded appState isConnectionUp <- if configDbChannelEnabled appConfig then AppState.getIsListenerOn appState - else isRight <$> AppState.usePool appState appConfig (SQL.sql "SELECT 1") observer + else isRight <$> AppState.usePool appState appConfig (SQL.sql "SELECT 1") case Wai.pathInfo req of ["ready"] -> diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index fa405f153..a10be5e05 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -60,19 +60,20 @@ import System.TimeIt (timeItT) type Handler = ExceptT Error -run :: AppState -> (Observation -> IO ()) -> IO () -run appState observer = do +run :: AppState -> IO () +run appState = do + conf@AppConfig{configObserver=observer, ..} <- AppState.getConfig appState + observer $ AppServerStartObs prettyVersion - conf@AppConfig{..} <- AppState.getConfig appState AppState.connectionWorker appState -- Loads the initial SchemaCache - Unix.installSignalHandlers (AppState.getMainThreadId appState) (AppState.connectionWorker appState) (AppState.reReadConfig False appState observer) + Unix.installSignalHandlers (AppState.getMainThreadId appState) (AppState.connectionWorker appState) (AppState.reReadConfig False appState) -- reload schema cache + config on NOTIFY - AppState.runListener conf appState observer + AppState.runListener conf appState - Admin.runAdmin conf appState (serverSettings conf) observer + Admin.runAdmin conf appState (serverSettings conf) - let app = postgrest configLogLevel appState (AppState.connectionWorker appState) observer + let app = postgrest configLogLevel appState (AppState.connectionWorker appState) case configServerUnixSocket of Just path -> do @@ -91,8 +92,8 @@ serverSettings AppConfig{..} = & setServerName ("postgrest/" <> prettyVersion) -- | PostgREST application -postgrest :: LogLevel -> AppState.AppState -> IO () -> (Observation -> IO ()) -> Wai.Application -postgrest logLevel appState connWorker observer = +postgrest :: LogLevel -> AppState.AppState -> IO () -> Wai.Application +postgrest logLevel appState connWorker = traceHeaderMiddleware appState . Cors.middleware appState . Auth.middleware appState . @@ -109,7 +110,7 @@ postgrest logLevel appState connWorker observer = let eitherResponse :: IO (Either Error Wai.Response) eitherResponse = - runExceptT $ postgrestResponse appState appConf maybeSchemaCache pgVer authResult req observer + runExceptT $ postgrestResponse appState appConf maybeSchemaCache pgVer authResult req response <- either Error.errorResponseFor identity <$> eitherResponse -- Launch the connWorker when the connection is down. The postgrest @@ -128,9 +129,8 @@ postgrestResponse -> PgVersion -> AuthResult -> Wai.Request - -> (Observation -> IO ()) -> Handler IO Wai.Response -postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@AuthResult{..} req observer = do +postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@AuthResult{..} req = do sCache <- case maybeSchemaCache of Just sCache -> @@ -144,7 +144,7 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@ (parseTime, apiReq@ApiRequest{..}) <- withTiming $ liftEither . mapLeft Error.ApiRequestError $ ApiRequest.userApiRequest conf req body sCache (planTime, plan) <- withTiming $ liftEither $ Plan.actionPlan iAction conf apiReq sCache - (queryTime, queryResult) <- withTiming $ Query.runQuery appState conf authResult apiReq plan sCache pgVer (Just authRole /= configDbAnonRole) observer + (queryTime, queryResult) <- withTiming $ Query.runQuery appState conf authResult apiReq plan sCache pgVer (Just authRole /= configDbAnonRole) (respTime, resp) <- withTiming $ liftEither $ Response.actionResponse queryResult apiReq (T.decodeUtf8 prettyVersion, docsVersion) conf sCache iSchema iNegotiatedByProfile return $ toWaiResponse (ServerTiming jwtTime parseTime planTime queryTime respTime) resp diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index 347132425..10b060fa4 100644 --- a/src/PostgREST/AppState.hs +++ b/src/PostgREST/AppState.hs @@ -24,7 +24,6 @@ module PostgREST.AppState , putSchemaCache , putPgVersion , usePool - , loadSchemaCache , reReadConfig , connectionWorker , runListener @@ -67,7 +66,8 @@ import PostgREST.Config.Database (queryDbSettings, import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion) import PostgREST.SchemaCache (SchemaCache (..), - querySchemaCache) + querySchemaCache, + showSummary) import PostgREST.SchemaCache.Identifiers (dumpQi) import PostgREST.Unix (createAndBindDomainSocket) @@ -115,15 +115,15 @@ data AppState = AppState type AppSockets = (NS.Socket, Maybe NS.Socket) -init :: AppConfig -> (Observation -> IO ()) -> IO AppState -init conf observer = do +init :: AppConfig -> IO AppState +init conf = do pool <- initPool conf (sock, adminSock) <- initSockets conf - state' <- initWithPool (sock, adminSock) pool conf observer + state' <- initWithPool (sock, adminSock) pool conf pure state' { stateSocketREST = sock, stateSocketAdmin = adminSock } -initWithPool :: AppSockets -> SQL.Pool -> AppConfig -> (Observation -> IO() ) -> IO AppState -initWithPool (sock, adminSock) pool conf observer = do +initWithPool :: AppSockets -> SQL.Pool -> AppConfig -> IO AppState +initWithPool (sock, adminSock) pool conf@AppConfig{configObserver=observer} = do appState <- AppState pool <$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step <*> newIORef Nothing @@ -152,7 +152,7 @@ initWithPool (sock, adminSock) pool conf observer = do debWorker <- let decisecond = 100000 in mkDebounce defaultDebounceSettings - { debounceAction = internalConnectionWorker appState observer + { debounceAction = internalConnectionWorker appState , debounceFreq = decisecond , debounceEdge = leadingEdge -- runs the worker at the start and the end } @@ -205,8 +205,8 @@ initPool AppConfig{..} = (toUtf8 $ addFallbackAppName prettyVersion configDbUri) -- | Run an action with a database connection. -usePool :: AppState -> AppConfig -> SQL.Session a -> (Observation -> IO ()) -> IO (Either SQL.UsageError a) -usePool AppState{..} AppConfig{configLogLevel} sess observer = do +usePool :: AppState -> AppConfig -> SQL.Session a -> IO (Either SQL.UsageError a) +usePool AppState{..} AppConfig{configLogLevel, configObserver=observer} sess = do res <- SQL.use statePool sess when (configLogLevel > LogCrit) $ do @@ -301,12 +301,12 @@ data SCacheStatus | SCFatalFail -- | Load the SchemaCache by using a connection from the pool. -loadSchemaCache :: AppState -> (Observation -> IO()) -> IO SCacheStatus -loadSchemaCache appState observer = do +loadSchemaCache :: AppState -> AppConfig -> IO SCacheStatus +loadSchemaCache appState AppConfig{configObserver=observer} = do conf@AppConfig{..} <- getConfig appState (resultTime, result) <- let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in - timeItT $ usePool appState conf (transaction SQL.ReadCommitted SQL.Read $ querySchemaCache conf) observer + timeItT $ usePool appState conf (transaction SQL.ReadCommitted SQL.Read $ querySchemaCache conf) case result of Left e -> do case checkIsFatal e of @@ -322,7 +322,7 @@ loadSchemaCache appState observer = do Right sCache -> do putSchemaCache appState $ Just sCache observer $ SchemaCacheQueriedObs resultTime - (t, _) <- timeItT $ observer $ SchemaCacheSummaryObs sCache + (t, _) <- timeItT $ observer $ SchemaCacheSummaryObs $ showSummary sCache observer $ SchemaCacheLoadedObs t putSchemaCacheLoaded appState True return SCLoaded @@ -345,13 +345,13 @@ data ConnectionStatus -- 2. Checks if the pg version is supported and if it's not it kills the main -- program. -- 3. Obtains the sCache. If this fails, it goes back to 1. -internalConnectionWorker :: AppState -> (Observation -> IO()) -> IO () -internalConnectionWorker appState observer = work +internalConnectionWorker :: AppState -> IO () +internalConnectionWorker appState = work where work = do - config@AppConfig{..} <- getConfig appState + config@AppConfig{configObserver=observer, ..} <- getConfig appState observer DBConnectAttemptObs - connected <- establishConnection appState config observer + connected <- establishConnection appState config case connected of FatalConnectionError reason -> -- Fatal error when connecting @@ -368,8 +368,8 @@ internalConnectionWorker appState observer = work observer (DBConnectedObs $ pgvFullName actualPgVersion) -- this could be fail because the connection drops, but the loadSchemaCache will pick the error and retry again -- We cannot retry after it fails immediately, because db-pre-config could have user errors. We just log the error and continue. - when configDbConfig $ reReadConfig False appState observer - scStatus <- loadSchemaCache appState observer + when configDbConfig $ reReadConfig False appState + scStatus <- loadSchemaCache appState config case scStatus of SCLoaded -> -- do nothing and proceed if the load was successful @@ -391,8 +391,8 @@ internalConnectionWorker appState observer = work -- -- The connection tries are capped, but if the connection times out no error is -- thrown, just 'False' is returned. -establishConnection :: AppState -> AppConfig -> (Observation -> IO ()) -> IO ConnectionStatus -establishConnection appState config observer = +establishConnection :: AppState -> AppConfig -> IO ConnectionStatus +establishConnection appState config@AppConfig{configObserver=observer} = retrying retrySettings shouldRetry $ const $ flushPool appState >> getConnectionStatus where @@ -402,7 +402,7 @@ establishConnection appState config observer = getConnectionStatus :: IO ConnectionStatus getConnectionStatus = do - pgVersion <- usePool appState config (queryPgVersion False) observer -- No need to prepare the query here, as the connection might not be established + pgVersion <- usePool appState config (queryPgVersion False) -- No need to prepare the query here, as the connection might not be established case pgVersion of Left e -> do observer $ ConnectionPgVersionErrorObs e @@ -430,13 +430,13 @@ establishConnection appState config observer = return itShould -- | Re-reads the config plus config options from the db -reReadConfig :: Bool -> AppState -> (Observation -> IO ()) -> IO () -reReadConfig startingUp appState observer = do - config@AppConfig{..} <- getConfig appState +reReadConfig :: Bool -> AppState -> IO () +reReadConfig startingUp appState = do + config@AppConfig{configObserver=observer, ..} <- getConfig appState pgVer <- getPgVersion appState dbSettings <- if configDbConfig then do - qDbSettings <- usePool appState config (queryDbSettings (dumpQi <$> configDbPreConfig) configDbPreparedStatements) observer + qDbSettings <- usePool appState config (queryDbSettings (dumpQi <$> configDbPreConfig) configDbPreparedStatements) case qDbSettings of Left e -> do observer ConfigReadErrorObs @@ -452,7 +452,7 @@ reReadConfig startingUp appState observer = do pure mempty (roleSettings, roleIsolationLvl) <- if configDbConfig then do - rSettings <- usePool appState config (queryRoleSettings pgVer configDbPreparedStatements) observer + rSettings <- usePool appState config (queryRoleSettings pgVer configDbPreparedStatements) case rSettings of Left e -> do observer $ QueryRoleSettingsErrorObs e @@ -460,7 +460,7 @@ reReadConfig startingUp appState observer = do Right x -> pure x else pure mempty - readAppConfig dbSettings configFilePath (Just configDbUri) roleSettings roleIsolationLvl >>= \case + readAppConfig dbSettings configFilePath (Just configDbUri) roleSettings roleIsolationLvl observer >>= \case Left err -> if startingUp then panic err -- die on invalid config if the program is starting up @@ -473,16 +473,15 @@ reReadConfig startingUp appState observer = do else observer ConfigSucceededObs -runListener :: AppConfig -> AppState -> (Observation -> IO ()) -> IO () -runListener AppConfig{configDbChannelEnabled} appState observer = - when configDbChannelEnabled $ listener appState observer +runListener :: AppConfig -> AppState -> IO () +runListener conf@AppConfig{configDbChannelEnabled} appState = do + when configDbChannelEnabled $ listener appState conf -- | Starts a dedicated pg connection to LISTEN for notifications. When a -- NOTIFY - with an empty payload - is done, it refills the schema -- cache. It uses the connectionWorker in case the LISTEN connection dies. -listener :: AppState -> (Observation -> IO ()) -> IO () -listener appState observer = do - AppConfig{..} <- getConfig appState +listener :: AppState -> AppConfig -> IO () +listener appState conf@AppConfig{configObserver=observer, ..} = do let dbChannel = toS configDbChannel -- The listener has to wait for a signal from the connectionWorker. @@ -515,12 +514,12 @@ listener appState observer = do -- assume the pool connection was also lost, call the connection worker connectionWorker appState -- retry the listener - listener appState observer + listener appState conf handleNotification channel msg = if | BS.null msg -> observer (DBListenerGotSCacheMsg channel) >> cacheReloader | msg == "reload schema" -> observer (DBListenerGotSCacheMsg channel) >> cacheReloader - | msg == "reload config" -> observer (DBListenerGotConfigMsg channel) >> reReadConfig False appState observer + | msg == "reload config" -> observer (DBListenerGotConfigMsg channel) >> reReadConfig False appState | otherwise -> pure () -- Do nothing if anything else than an empty message is sent cacheReloader = diff --git a/src/PostgREST/CLI.hs b/src/PostgREST/CLI.hs index 2e9f79be7..68ef441d8 100644 --- a/src/PostgREST/CLI.hs +++ b/src/PostgREST/CLI.hs @@ -32,22 +32,23 @@ import Protolude hiding (hPutStrLn) main :: CLI -> IO () main CLI{cliCommand, cliPath} = do - conf@AppConfig{..} <- - either panic identity <$> Config.readAppConfig mempty cliPath Nothing mempty mempty - loggerState <- Logger.init + + conf@AppConfig{..} <- + either panic identity <$> Config.readAppConfig mempty cliPath Nothing mempty mempty (Logger.observationLogger loggerState) + -- Per https://github.com/PostgREST/postgrest/issues/268, we want to -- explicitly close the connections to PostgreSQL on shutdown. -- 'AppState.destroy' takes care of that. bracket - (AppState.init conf $ Logger.logObservation loggerState) + (AppState.init conf) AppState.destroy (\appState -> case cliCommand of CmdDumpConfig -> do - when configDbConfig $ AppState.reReadConfig True appState (const $ pure ()) + when configDbConfig $ AppState.reReadConfig True appState putStr . Config.toText =<< AppState.getConfig appState CmdDumpSchema -> putStrLn =<< dumpSchema appState - CmdRun -> App.run appState (Logger.logObservation loggerState)) + CmdRun -> App.run appState) -- | Dump SchemaCache schema to JSON dumpSchema :: AppState -> IO LBS.ByteString @@ -57,7 +58,6 @@ dumpSchema appState = do let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in AppState.usePool appState conf (transaction SQL.ReadCommitted SQL.Read $ querySchemaCache conf) - (const $ pure ()) case result of Left e -> do hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index 6d4de526d..f8d1f7062 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -64,6 +64,8 @@ import PostgREST.Config.Proxy (Proxy (..), import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier, dumpQi, toQi) +import PostgREST.Observation + import Protolude hiding (Proxy, toList) @@ -112,6 +114,7 @@ data AppConfig = AppConfig , configRoleSettings :: RoleSettings , configRoleIsoLvl :: RoleIsolationLvl , configInternalSCSleep :: Maybe Int32 + , configObserver :: ObservationHandler } data LogLevel = LogCrit | LogError | LogWarn | LogInfo @@ -210,13 +213,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 -> RoleIsolationLvl -> IO (Either Text AppConfig) -readAppConfig dbSettings optPath prevDbUri roleSettings roleIsolationLvl = do +readAppConfig :: [(Text, Text)] -> Maybe FilePath -> Maybe Text -> RoleSettings -> RoleIsolationLvl -> ObservationHandler -> IO (Either Text AppConfig) +readAppConfig dbSettings optPath prevDbUri roleSettings roleIsolationLvl observer = 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 roleIsolationLvl) =<< mapLeft show conf of + case C.runParser (parser optPath env dbSettings roleSettings roleIsolationLvl observer) =<< mapLeft show conf of Left err -> return . Left $ "Error in config " <> err Right parsedConfig -> @@ -231,8 +234,8 @@ readAppConfig dbSettings optPath prevDbUri roleSettings roleIsolationLvl = do decodeJWKS <$> (decodeSecret =<< readSecretFile =<< readDbUriFile prevDbUri parsedConfig) -parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> RoleSettings -> RoleIsolationLvl -> C.Parser C.Config AppConfig -parser optPath env dbSettings roleSettings roleIsolationLvl = +parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> RoleSettings -> RoleIsolationLvl -> ObservationHandler -> C.Parser C.Config AppConfig +parser optPath env dbSettings roleSettings roleIsolationLvl observer = AppConfig <$> parseAppSettings "app.settings" <*> (fromMaybe False <$> optBool "db-aggregates-enabled") @@ -285,6 +288,7 @@ parser optPath env dbSettings roleSettings roleIsolationLvl = <*> pure roleSettings <*> pure roleIsolationLvl <*> optInt "internal-schema-cache-sleep" + <*> pure observer where parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)] parseAppSettings key = addFromEnv . fmap (fmap coerceText) <$> C.subassocs key C.value diff --git a/src/PostgREST/Logger.hs b/src/PostgREST/Logger.hs index f214dbca8..43766d333 100644 --- a/src/PostgREST/Logger.hs +++ b/src/PostgREST/Logger.hs @@ -4,7 +4,7 @@ Description : Wai Middleware to log requests to stdout. -} module PostgREST.Logger ( middleware - , logObservation + , observationLogger , init ) where @@ -50,8 +50,8 @@ middleware logLevel = case logLevel of & Wai.setApacheUserGetter Auth.getRole } -logObservation :: LoggerState -> Observation -> IO () -logObservation loggerState obs = logWithZTime loggerState $ observationMessage obs +observationLogger :: LoggerState -> ObservationHandler +observationLogger loggerState obs = logWithZTime loggerState $ observationMessage obs logWithZTime :: LoggerState -> Text -> IO () logWithZTime loggerState txt = do diff --git a/src/PostgREST/Observation.hs b/src/PostgREST/Observation.hs index de0396539..3cb863584 100644 --- a/src/PostgREST/Observation.hs +++ b/src/PostgREST/Observation.hs @@ -6,17 +6,17 @@ Description : Module for observability types module PostgREST.Observation ( Observation(..) , observationMessage + , ObservationHandler ) where -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Hasql.Connection as SQL -import qualified Hasql.Pool as SQL -import qualified Network.Socket as NS -import Numeric (showFFloat) -import qualified PostgREST.Error as Error -import PostgREST.SchemaCache (SchemaCache, showSummary) +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Hasql.Connection as SQL +import qualified Hasql.Pool as SQL +import qualified Network.Socket as NS +import Numeric (showFFloat) +import qualified PostgREST.Error as Error import Protolude import Protolude.Partial (fromJust) @@ -33,7 +33,7 @@ data Observation | SchemaCacheFatalErrorObs SQL.UsageError Text | SchemaCacheNormalErrorObs SQL.UsageError | SchemaCacheQueriedObs Double - | SchemaCacheSummaryObs SchemaCache + | SchemaCacheSummaryObs Text | SchemaCacheLoadedObs Double | ConnectionRetryObs Int | ConnectionPgVersionErrorObs SQL.UsageError @@ -51,6 +51,8 @@ data Observation | QueryErrorCodeHighObs SQL.UsageError | PoolAcqTimeoutObs SQL.UsageError +type ObservationHandler = Observation -> IO () + observationMessage :: Observation -> Text observationMessage = \case AdminStartObs port -> @@ -75,8 +77,8 @@ observationMessage = \case "An error ocurred when loading the schema cache. " <> jsonMessage usageErr SchemaCacheQueriedObs resultTime -> "Schema cache queried in " <> showMillis resultTime <> " milliseconds" - SchemaCacheSummaryObs sCache -> - "Schema cache loaded " <> showSummary sCache + SchemaCacheSummaryObs summary -> + "Schema cache loaded " <> summary SchemaCacheLoadedObs resultTime -> "Schema cache loaded in " <> showMillis resultTime <> " milliseconds" ConnectionRetryObs delay -> diff --git a/src/PostgREST/Query.hs b/src/PostgREST/Query.hs index 2a1274c26..7a1b319fd 100644 --- a/src/PostgREST/Query.hs +++ b/src/PostgREST/Query.hs @@ -43,7 +43,6 @@ import PostgREST.Config (AppConfig (..), import PostgREST.Config.PgVersion (PgVersion (..)) import PostgREST.Error (Error) import PostgREST.MediaType (MediaType (..)) -import PostgREST.Observation (Observation (..)) import PostgREST.Plan (ActionPlan (..), CallReadPlan (..), CrudPlan (..), @@ -75,12 +74,12 @@ data QueryResult | NoDbResult InfoPlan -- TODO This function needs to be free from IO, only App.hs should do IO -runQuery :: AppState.AppState -> AppConfig -> AuthResult -> ApiRequest -> ActionPlan -> SchemaCache -> PgVersion -> Bool -> (Observation -> IO ()) -> ExceptT Error IO QueryResult -runQuery _ _ _ _ (NoDb x) _ _ _ _ = pure $ NoDbResult x -runQuery appState config AuthResult{..} apiReq (Db plan) sCache pgVer authenticated observer = do +runQuery :: AppState.AppState -> AppConfig -> AuthResult -> ApiRequest -> ActionPlan -> SchemaCache -> PgVersion -> Bool -> ExceptT Error IO QueryResult +runQuery _ _ _ _ (NoDb x) _ _ _ = pure $ NoDbResult x +runQuery appState config AuthResult{..} apiReq (Db plan) sCache pgVer authenticated = do dbResp <- lift $ do let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction - AppState.usePool appState config (transaction isoLvl txMode $ runExceptT dbHandler) observer + AppState.usePool appState config (transaction isoLvl txMode $ runExceptT dbHandler) resp <- liftEither . mapLeft Error.PgErr $ diff --git a/test/spec/Main.hs b/test/spec/Main.hs index 8c31bcd64..b4ab6389c 100644 --- a/test/spec/Main.hs +++ b/test/spec/Main.hs @@ -77,21 +77,20 @@ main = do sockets <- AppState.initSockets testCfg let - noObs = const $ pure () -- For tests that run with the same refSchemaCache app config = do - appState <- AppState.initWithPool sockets pool config noObs + appState <- AppState.initWithPool sockets pool config AppState.putPgVersion appState actualPgVersion AppState.putSchemaCache appState (Just baseSchemaCache) - return ((), postgrest (configLogLevel config) appState (pure ()) noObs) + return ((), postgrest (configLogLevel config) appState (pure ())) -- For tests that run with a different SchemaCache(depends on configSchemas) appDbs config = do customSchemaCache <- loadSCache pool config - appState <- AppState.initWithPool sockets pool config noObs + appState <- AppState.initWithPool sockets pool config AppState.putPgVersion appState actualPgVersion AppState.putSchemaCache appState (Just customSchemaCache) - return ((), postgrest (configLogLevel config) appState (pure ()) noObs) + return ((), postgrest (configLogLevel config) appState (pure ())) let withApp = app testCfg maxRowsApp = app testMaxRowsCfg diff --git a/test/spec/SpecHelper.hs b/test/spec/SpecHelper.hs index 0717ef12b..6c73d1500 100644 --- a/test/spec/SpecHelper.hs +++ b/test/spec/SpecHelper.hs @@ -141,6 +141,7 @@ baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in , configRoleIsoLvl = mempty , configInternalSCSleep = Nothing , configServerTimingEnabled = True + , configObserver = const $ pure () } testCfg :: AppConfig