diff --git a/postgrest.cabal b/postgrest.cabal index 2f100b3e92..be65e4efe3 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -70,6 +70,7 @@ library PostgREST.Listener PostgREST.Logger PostgREST.MainTx + PostgREST.Logger.Apache PostgREST.MediaType PostgREST.Metrics PostgREST.Network @@ -116,6 +117,7 @@ library , directory >= 1.2.6 && < 1.4 , either >= 4.4.1 && < 5.1 , extra >= 1.7.0 && < 2.0 + , fast-logger >= 3.2.0 && < 3.3 , fuzzyset >= 0.2.4 && < 0.3 , hasql >= 1.9 && <= 1.9.3.1 , hasql-dynamic-statements >= 0.3.1 && <= 0.3.1.8 @@ -147,7 +149,6 @@ library , time >= 1.6 && < 1.15 , unordered-containers >= 0.2.8 && < 0.3 , unix-compat >= 0.5.4 && < 0.8 - , vault >= 0.3.1.5 && < 0.4 , vector >= 0.11 && < 0.14 , wai >= 3.2.1 && < 3.3 , wai-cors >= 0.2.5 && < 0.3 diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index 6cf7f3c7cf..b3434887d1 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -8,6 +8,7 @@ module PostgREST.ApiRequest ( ApiRequest(..) , userApiRequest , userPreferences + , userBearerAuth ) where import qualified Data.CaseInsensitive as CI @@ -16,13 +17,15 @@ import qualified Data.List.NonEmpty as NonEmptyList import qualified Data.Set as S import qualified Data.Text.Encoding as T -import Data.List (lookup) -import Data.Ranged.Ranges (emptyRange, rangeIntersection, - rangeIsEmpty) -import Network.HTTP.Types.Header (RequestHeaders, hCookie) -import Network.Wai (Request (..)) -import Network.Wai.Parse (parseHttpAccept) -import Web.Cookie (parseCookies) +import Data.List (lookup) +import Data.Ranged.Ranges (emptyRange, rangeIntersection, + rangeIsEmpty) +import Network.HTTP.Types.Header (RequestHeaders, + hAuthorization, hCookie) +import Network.Wai (Request (..)) +import Network.Wai.Middleware.HttpAuth (extractBearerAuth) +import Network.Wai.Parse (parseHttpAccept) +import Web.Cookie (parseCookies) import PostgREST.ApiRequest.Payload (getPayload) import PostgREST.ApiRequest.QueryParams (QueryParams (..)) @@ -114,6 +117,10 @@ userApiRequest conf prefs req reqBody = do userPreferences :: AppConfig -> Request -> TimezoneNames -> Preferences.Preferences userPreferences conf req timezones = Preferences.fromHeaders (configDbTxAllowOverride conf) timezones $ requestHeaders req +-- | Obtains the Bearer Auth +userBearerAuth :: Request -> Maybe ByteString +userBearerAuth req = extractBearerAuth =<< lookup hAuthorization (requestHeaders req) + getResource :: AppConfig -> [Text] -> Either ApiRequestError Resource getResource AppConfig{configOpenApiMode, configDbRootSpec} = \case [] -> diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 81f1b66722..25f7f03a23 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -9,6 +9,7 @@ Some of its functionality includes: - Producing HTTP Headers according to RFCs. - Content Negotiation -} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -24,7 +25,6 @@ import System.IO.Error (ioeGetErrorType) import Control.Monad.Except (liftEither) import Control.Monad.Extra (whenJust) import Data.Either.Combinators (mapLeft, whenLeft) -import Data.Maybe (fromJust) import Data.String (IsString (..)) import Network.Wai.Handler.Warp (defaultSettings, setHost, setOnException, setPort, @@ -33,6 +33,7 @@ import Network.Wai.Handler.Warp (defaultSettings, setHost, import qualified Data.Text.Encoding as T import qualified Network.Wai as Wai import qualified Network.Wai.Handler.Warp as Warp +import qualified Network.Wai.Header as WaiHeader import qualified PostgREST.Admin as Admin import qualified PostgREST.ApiRequest as ApiRequest @@ -41,7 +42,6 @@ import qualified PostgREST.Auth as Auth import qualified PostgREST.Cors as Cors import qualified PostgREST.Error as Error import qualified PostgREST.Listener as Listener -import qualified PostgREST.Logger as Logger import qualified PostgREST.MainTx as MainTx import qualified PostgREST.Plan as Plan import qualified PostgREST.Query as Query @@ -51,7 +51,7 @@ import qualified PostgREST.Unix as Unix (installSignalHandlers) import PostgREST.ApiRequest (ApiRequest (..)) import PostgREST.AppState (AppState) import PostgREST.Auth.Types (AuthResult (..)) -import PostgREST.Config (AppConfig (..), LogLevel (..)) +import PostgREST.Config (AppConfig (..)) import PostgREST.Error (Error) import PostgREST.Network (resolveSocketToAddress) import PostgREST.Observation (Observation (..)) @@ -72,11 +72,9 @@ import qualified Network.Socket as NS import PostgREST.Unix (createAndBindDomainSocket) import Protolude hiding (Handler) -type Handler = ExceptT Error - run :: AppState -> IO () run appState = do - conf@AppConfig{..} <- AppState.getConfig appState + conf <- AppState.getConfig appState AppState.schemaCacheLoader appState -- Loads the initial SchemaCache (mainSocket, adminSocket) <- initSockets conf @@ -89,7 +87,7 @@ run appState = do Admin.runAdmin appState adminSocket mainSocket (serverSettings conf) - let app = postgrest configLogLevel appState (AppState.schemaCacheLoader appState) + let app = postgrest appState (AppState.schemaCacheLoader appState) do address <- resolveSocketToAddress mainSocket @@ -122,48 +120,59 @@ serverSettings AppConfig{..} = & setServerName ("postgrest/" <> prettyVersion) -- | PostgREST application -postgrest :: LogLevel -> AppState.AppState -> IO () -> Wai.Application -postgrest logLevel appState connWorker = +postgrest :: AppState.AppState -> IO () -> Wai.Application +postgrest appState connWorker = traceHeaderMiddleware appState . - Cors.middleware appState . - Auth.middleware appState . - Logger.middleware logLevel Auth.getRole $ - -- fromJust can be used, because the auth middleware will **always** add - -- some AuthResult to the vault. + Cors.middleware appState $ \req respond -> do appConf@AppConfig{..} <- AppState.getConfig appState -- the config must be read again because it can reload - case fromJust $ Auth.getResult req of - Left err -> respond $ Error.errorResponseFor configClientErrorVerbosity err - Right authResult -> do - maybeSchemaCache <- AppState.getSchemaCache appState - - let - eitherResponse :: IO (Either Error Wai.Response) - eitherResponse = - runExceptT $ postgrestResponse appState appConf maybeSchemaCache authResult req - - response <- either (Error.errorResponseFor configClientErrorVerbosity) identity <$> eitherResponse - -- Launch the connWorker when the connection is down. The postgrest - -- function can respond successfully (with a stale schema cache) before - -- the connWorker is done. However, when there's an empty schema cache - -- postgrest responds with the error `PGRST002`; this means that the schema - -- cache is still loading, so we don't launch the connWorker here because - -- it would duplicate the loading process, e.g. https://github.com/PostgREST/postgrest/issues/3704 - -- TODO: this process may be unnecessary when the Listener is enabled. Revisit once https://github.com/PostgREST/postgrest/issues/1766 is done - when (isServiceUnavailable response && isJust maybeSchemaCache) connWorker - resp <- do - delay <- AppState.getNextDelay appState - return $ addRetryHint delay response - respond resp + maybeSchemaCache <- AppState.getSchemaCache appState + + let observer = AppState.getObserver appState + bearerAuth = ApiRequest.userBearerAuth req + + response <- do + authResultE <- runExceptT $ withTiming appConf $ + liftIO (Auth.getAuthResult appState bearerAuth) >>= liftEither + + case authResultE of + Left err -> do + let resp = Error.errorResponseFor configClientErrorVerbosity err + observer $ genResponseObs Nothing req resp + pure resp + + Right (jwtTime, authResult@AuthResult{..}) -> do + resp <- either (Error.errorResponseFor configClientErrorVerbosity) identity <$> + runExceptT (postgrestResponse appState appConf maybeSchemaCache jwtTime authResult req) + observer $ genResponseObs (Just authRole) req resp + pure resp + + -- Launch the connWorker when the connection is down. The postgrest + -- function can respond successfully (with a stale schema cache) before + -- the connWorker is done. However, when there's an empty schema cache + -- postgrest responds with the error `PGRST002`; this means that the schema + -- cache is still loading, so we don't launch the connWorker here because + -- it would duplicate the loading process, e.g. https://github.com/PostgREST/postgrest/issues/3704 + -- TODO: this process may be unnecessary when the Listener is enabled. Revisit once https://github.com/PostgREST/postgrest/issues/1766 is done + when (isServiceUnavailable response && isJust maybeSchemaCache) connWorker + delay <- AppState.getNextDelay appState + respond $ addRetryHint delay response + where + -- TODO WaiHeader.contentLength does a lookup everytime, see: https://hackage.haskell.org/package/wai-extra-3.1.17/docs/src/Network.Wai.Header.html#contentLength + -- It might be possible to gain some perf by returning the response length from `postgrestResponse`. We calculate the length manually on Response.hs. + genResponseObs :: Maybe ByteString -> Wai.Request -> Wai.Response -> Observation + genResponseObs user req resp = + ResponseObs user req (Wai.responseStatus resp) (WaiHeader.contentLength $ Wai.responseHeaders resp) postgrestResponse :: AppState.AppState -> AppConfig -> Maybe SchemaCache + -> Maybe Double -> AuthResult -> Wai.Request - -> Handler IO Wai.Response -postgrestResponse appState conf@AppConfig{..} maybeSchemaCache authResult@AuthResult{..} req = do + -> ExceptT Error IO Wai.Response +postgrestResponse appState conf@AppConfig{..} maybeSchemaCache jwtTime authResult@AuthResult{..} req = do let observer = AppState.getObserver appState sCache <- @@ -174,20 +183,18 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache authResult@AuthRe lift $ observer SchemaCacheEmptyObs throwError Error.NoSchemaCacheError - body <- lift $ Wai.strictRequestBody req + let prefs = ApiRequest.userPreferences conf req (dbTimezones sCache) - let jwtTime = if configServerTimingEnabled then Auth.getJwtDur req else Nothing - timezones = dbTimezones sCache - prefs = ApiRequest.userPreferences conf req timezones + body <- lift $ Wai.strictRequestBody req - (parseTime, apiReq@ApiRequest{..}) <- withTiming $ liftEither . mapLeft Error.ApiRequestErr $ ApiRequest.userApiRequest conf prefs req body - (planTime, plan) <- withTiming $ liftEither $ Plan.actionPlan iAction conf apiReq sCache + (parseTime, apiReq@ApiRequest{..}) <- withTiming conf $ liftEither . mapLeft Error.ApiRequestErr $ ApiRequest.userApiRequest conf prefs req body + (planTime, plan) <- withTiming conf $ liftEither $ Plan.actionPlan iAction conf apiReq sCache let mainQ = Query.mainQuery plan conf apiReq authResult configDbPreRequest tx = MainTx.mainTx mainQ conf authResult apiReq plan sCache obsQuery s = when configLogQuery $ observer $ QueryObs mainQ s - (txTime, txResult) <- withTiming $ do + (txTime, txResult) <- withTiming conf $ do case tx of MainTx.NoDbTx r -> pure r MainTx.DbTx{..} -> do @@ -200,7 +207,7 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache authResult@AuthRe lift $ whenLeft eitherResp $ obsQuery . Error.status liftEither eitherResp - (respTime, resp) <- withTiming $ do + (respTime, resp) <- withTiming conf $ do let response = Response.actionResponse txResult apiReq (T.decodeUtf8 prettyVersion, docsVersion) conf sCache status' = either Error.status Response.pgrstStatus response @@ -224,14 +231,14 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache authResult@AuthRe varyHeaderPresent :: [HTTP.Header] -> Bool varyHeaderPresent = any (\(h, _v) -> h == HTTP.hVary) - withTiming :: Handler IO a -> Handler IO (Maybe Double, a) - withTiming f = if configServerTimingEnabled - then do - (t, r) <- timeItT f - pure (Just t, r) - else do - r <- f - pure (Nothing, r) +withTiming :: AppConfig -> ExceptT e IO a -> ExceptT e IO (Maybe Double, a) +withTiming AppConfig{configServerTimingEnabled} f = if configServerTimingEnabled + then do + (t, r) <- timeItT f + pure (Just t, r) + else do + r <- f + pure (Nothing, r) traceHeaderMiddleware :: AppState -> Wai.Middleware traceHeaderMiddleware appState app req respond = do diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs index 92a20d2d18..114512d108 100644 --- a/src/PostgREST/Auth.hs +++ b/src/PostgREST/Auth.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} {-| Module : PostgREST.Auth Description : PostgREST authentication functions. @@ -12,66 +11,28 @@ In the test suite there is an example of simple login function that can be used very simple authentication system inside the PostgreSQL database. -} module PostgREST.Auth - ( getResult - , getJwtDur - , getRole - , middleware - ) where - -import qualified Data.ByteString as BS -import qualified Data.Vault.Lazy as Vault -import qualified Network.HTTP.Types.Header as HTTP -import qualified Network.Wai as Wai -import qualified Network.Wai.Middleware.HttpAuth as Wai - -import Data.List (lookup) -import PostgREST.TimeIt (timeItT) -import System.IO.Unsafe (unsafePerformIO) + ( getAuthResult ) + where import PostgREST.AppState (AppState, getConfig, getJwtCacheState, getTime) import PostgREST.Auth.Jwt (parseClaims) import PostgREST.Auth.JwtCache (lookupJwtCache) -import PostgREST.Auth.Types (AuthResult (..)) -import PostgREST.Config (AppConfig (..)) -import PostgREST.Error (Error (..)) +import PostgREST.Auth.Types (AuthResult) +import PostgREST.Error (Error) import Protolude --- | Validate authorization header --- Parse and store JWT claims for future use in the request. -middleware :: AppState -> Wai.Middleware -middleware appState app req respond = do - conf@AppConfig{..} <- getConfig appState +-- | Perform authentication and authorization +-- Parse JWT and return AuthResult +getAuthResult :: AppState -> Maybe ByteString -> IO (Either Error AuthResult) +getAuthResult appState token = do + conf <- getConfig appState time <- getTime appState - let token = Wai.extractBearerAuth =<< lookup HTTP.hAuthorization (Wai.requestHeaders req) - parseJwt = runExceptT $ lookupJwtCache jwtCacheState token >>= parseClaims conf time - jwtCacheState = getJwtCacheState appState - - -- If ServerTimingEnabled -> calculate JWT validation time - req' <- if configServerTimingEnabled then do - (dur, authResult) <- timeItT parseJwt - pure $ req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult & Vault.insert jwtDurKey dur } - else do - authResult <- parseJwt - pure $ req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult } - - app req' respond - -authResultKey :: Vault.Key (Either Error AuthResult) -authResultKey = unsafePerformIO Vault.newKey -{-# NOINLINE authResultKey #-} - -getResult :: Wai.Request -> Maybe (Either Error AuthResult) -getResult = Vault.lookup authResultKey . Wai.vault - -jwtDurKey :: Vault.Key Double -jwtDurKey = unsafePerformIO Vault.newKey -{-# NOINLINE jwtDurKey #-} - -getJwtDur :: Wai.Request -> Maybe Double -getJwtDur = Vault.lookup jwtDurKey . Wai.vault + let jwtCacheState = getJwtCacheState appState + parseJwt = runExceptT $ do + claims <- lookupJwtCache jwtCacheState token + parseClaims conf time claims -getRole :: Wai.Request -> Maybe BS.ByteString -getRole req = authRole <$> (rightToMaybe =<< getResult req) + parseJwt diff --git a/src/PostgREST/Logger.hs b/src/PostgREST/Logger.hs index cb2a22ba89..3a128331e5 100644 --- a/src/PostgREST/Logger.hs +++ b/src/PostgREST/Logger.hs @@ -7,8 +7,7 @@ Description : Logging based on the Observation.hs module. Access logs get sent t -} -- TODO log with buffering enabled to not lose throughput on logging levels higher than LogError module PostgREST.Logger - ( middleware - , observationLogger + (observationLogger , init , LoggerState ) where @@ -26,17 +25,14 @@ import qualified Hasql.Statement as SQL import Data.Time (ZonedTime, defaultTimeLocale, formatTime, getZonedTime) -import qualified Network.Wai as Wai -import qualified Network.Wai.Middleware.RequestLogger as Wai - import Network.HTTP.Types.Status (Status, status400, status500) -import System.IO.Unsafe (unsafePerformIO) -import PostgREST.Config (LogLevel (..), Verbosity (..)) -import PostgREST.Debounce (makeDebouncer) +import PostgREST.Config (LogLevel (..), Verbosity (..)) +import PostgREST.Debounce (makeDebouncer) +import PostgREST.Logger.Apache (apacheFormat) import PostgREST.Observation -import PostgREST.Query (MainQuery (..)) -import PostgREST.SchemaCache (queryTimingsWLabels) +import PostgREST.Query (MainQuery (..)) +import PostgREST.SchemaCache (queryTimingsWLabels) import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T @@ -63,20 +59,6 @@ init = mdo logWithZTime loggerState (observationMessages PoolAcqTimeoutObs) *> threadDelay (5 * oneSecond) pure loggerState --- TODO stop using this middleware to reuse the same "observer" pattern for all our logs -middleware :: LogLevel -> (Wai.Request -> Maybe BS.ByteString) -> Wai.Middleware -middleware logLevel getAuthRole = - unsafePerformIO $ - Wai.mkRequestLogger Wai.defaultRequestLoggerSettings - { Wai.outputFormat = - Wai.ApacheWithSettings $ - Wai.defaultApacheSettings & - Wai.setApacheRequestFilter (\_ res -> shouldLogResponse logLevel $ Wai.responseStatus res) & - Wai.setApacheUserGetter getAuthRole - , Wai.autoFlush = True - , Wai.destination = Wai.Handle stdout - } - shouldLogResponse :: LogLevel -> Status -> Bool shouldLogResponse logLevel = case logLevel of LogCrit -> const False @@ -109,6 +91,10 @@ observationLogger loggerState logLevel obs = case obs of o@PoolRequestFullfilled -> when (logLevel >= LogDebug) $ do logWithZTime loggerState $ observationMessages o + ResponseObs maybeRole req status contentLen -> + when (shouldLogResponse logLevel status) $ do + zTime <- stateGetZTime loggerState + putStr $ apacheFormat maybeRole (BS.pack $ formatZonedTime zTime) req status contentLen -- putStr prints to stdout o@PoolFlushed -> when (logLevel >= LogDebug) $ do logWithZTime loggerState $ observationMessages o @@ -127,7 +113,11 @@ observationLogger loggerState logLevel obs = case obs of logWithZTime :: LoggerState -> [Text] -> IO () logWithZTime loggerState txts = do zTime <- stateGetZTime loggerState - traverse_ (hPutStrLn stderr . (toS (formatTime defaultTimeLocale "%d/%b/%Y:%T %z: " zTime) <>)) txts + let prefix = toS (formatZonedTime zTime) <> ": " + traverse_ (hPutStrLn stderr . (prefix <>)) txts + +formatZonedTime :: ZonedTime -> [Char] +formatZonedTime = formatTime defaultTimeLocale "%d/%b/%Y:%T %z" -- TODO: maybe patch upstream hasql-dynamic-statements so we have a less hackish way to convert -- the SQL.Snippet or maybe don't use hasql-dynamic-statements and resort to plain strings for the queries and use regular hasql @@ -243,6 +233,8 @@ observationMessages = \case pure $ "Received termination unix signal " <> signal WarpServerObs txt -> pure $ "Warp server: " <> txt + ResponseObs {} -> + mempty -- TODO this message is produced on observationLogger since it depends on Logger state. Merge observationMessages with observationLogger to clear this. where showMillis :: Double -> Text showMillis x = toS $ showFFloat (Just 1) x "" diff --git a/src/PostgREST/Logger/Apache.hs b/src/PostgREST/Logger/Apache.hs new file mode 100644 index 0000000000..0845065ddc --- /dev/null +++ b/src/PostgREST/Logger/Apache.hs @@ -0,0 +1,48 @@ +module PostgREST.Logger.Apache + ( apacheFormat + ) where + +import qualified Data.ByteString.Char8 as BS +import Network.Wai.Logger +import System.Log.FastLogger + +import Network.HTTP.Types.Status (Status, statusCode) +import Network.Wai + +import Protolude + +apacheFormat :: ToLogStr user => Maybe user -> FormattedTime -> Request -> Status -> Maybe Integer -> ByteString +apacheFormat maybeUser tmstr req status msize = + fromLogStr $ apacheLogStr maybeUser tmstr req status msize + +-- This code is vendored from +-- https://github.com/kazu-yamamoto/logger/blob/57bc4d3b26ca094fd0c3a8a8bb4421bcdcdd7061/wai-logger/Network/Wai/Logger/Apache.hs#L44-L45 +apacheLogStr :: ToLogStr user => Maybe user -> FormattedTime -> Request -> Status -> Maybe Integer -> LogStr +apacheLogStr maybeUser tmstr req status msize = + toLogStr (getSourceFromSocket req) + <> " - " + <> maybe "-" toLogStr maybeUser + <> " [" + <> toLogStr tmstr + <> "] \"" + <> toLogStr (requestMethod req) + <> " " + <> toLogStr path + <> " " + <> toLogStr (show (httpVersion req)::Text) + <> "\" " + <> toLogStr (show (statusCode status)::Text) + <> " " + <> toLogStr (maybe "-" show msize::Text) + <> " \"" + <> toLogStr (fromMaybe "" mr) + <> "\" \"" + <> toLogStr (fromMaybe "" mua) + <> "\"\n" + where + path = rawPathInfo req <> rawQueryString req + mr = requestHeaderReferer req + mua = requestHeaderUserAgent req + +getSourceFromSocket :: Request -> ByteString +getSourceFromSocket = BS.pack . showSockAddr . remoteHost diff --git a/src/PostgREST/Observation.hs b/src/PostgREST/Observation.hs index 0fde28d013..cabf8fdd26 100644 --- a/src/PostgREST/Observation.hs +++ b/src/PostgREST/Observation.hs @@ -16,6 +16,7 @@ import qualified Hasql.Connection as SQL import qualified Hasql.Pool as SQL import qualified Hasql.Pool.Observation as SQL import Network.HTTP.Types.Status (Status) +import qualified Network.Wai as Wai import PostgREST.Config.PgVersion import PostgREST.Query (MainQuery) import PostgREST.SchemaCache (QueryTimings) @@ -52,6 +53,7 @@ data Observation | PoolInit Int | PoolAcqTimeoutObs | HasqlPoolObs SQL.Observation + | ResponseObs (Maybe ByteString) Wai.Request Status (Maybe Integer) | PoolRequest | PoolRequestFullfilled | PoolFlushed diff --git a/test/observability/Main.hs b/test/observability/Main.hs index 2173161220..5fcc737ccf 100644 --- a/test/observability/Main.hs +++ b/test/observability/Main.hs @@ -58,7 +58,7 @@ main = do appState <- AppState.initWithPool pool config loggerState metricsState (Metrics.observationMetrics metricsState <> writeChan obsChan) AppState.putPgVersion appState actualPgVersion AppState.putSchemaCache appState (Just sCache) - return (SpecState appState metricsState stateObsChan, postgrest (configLogLevel config) appState (pure ())) + return (SpecState appState metricsState stateObsChan, postgrest appState (pure ())) -- Run all test modules hspec $ do diff --git a/test/spec/Main.hs b/test/spec/Main.hs index 01b218cd14..194aacba4f 100644 --- a/test/spec/Main.hs +++ b/test/spec/Main.hs @@ -90,19 +90,19 @@ main = do metricsState <- Metrics.init (configDbPoolSize testCfg) let - initApp sCache st config = do + initApp sCache config = do appState <- AppState.initWithPool pool config loggerState metricsState (Metrics.observationMetrics metricsState) AppState.putPgVersion appState actualPgVersion AppState.putSchemaCache appState (Just sCache) - return (st, postgrest (configLogLevel config) appState (pure ())) + return ((), postgrest appState (pure ())) -- For tests that run with the same schema cache - app = initApp baseSchemaCache () + app = initApp baseSchemaCache -- For tests that run with a different SchemaCache (depends on configSchemas) appDbs config = do customSchemaCache <- loadSCache pool config - initApp customSchemaCache () config + initApp customSchemaCache config let withApp = app testCfg maxRowsApp = app testMaxRowsCfg