diff --git a/CHANGELOG.md b/CHANGELOG.md index e7820359fc..a0c484d35f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,7 @@ This project adheres to [Semantic Versioning](http://semver.org/). - #2824, Fix range request with 0 rows and 0 offset return status 416 - @strengthless ## [11.2.1] - 2023-10-03 + - #2983, Add more data to `Server-Timing` header - @develop7 ### Fixed diff --git a/postgrest.cabal b/postgrest.cabal index 567e6fe50c..d2563c9ad0 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -71,6 +71,7 @@ library PostgREST.Response PostgREST.Response.OpenAPI PostgREST.Response.GucHeader + PostgREST.Response.Performance PostgREST.Version other-modules: Paths_postgrest build-depends: base >= 4.9 && < 4.17 diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index aed65e8893..ba1e589537 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -45,23 +45,27 @@ import qualified PostgREST.Plan as Plan import qualified PostgREST.Query as Query import qualified PostgREST.Response as Response -import PostgREST.ApiRequest (Action (..), ApiRequest (..), - Mutation (..), Target (..)) -import PostgREST.AppState (AppState) -import PostgREST.Auth (AuthResult (..)) -import PostgREST.Config (AppConfig (..)) -import PostgREST.Config.PgVersion (PgVersion (..)) -import PostgREST.Error (Error) -import PostgREST.Query (DbHandler) -import PostgREST.Response (ServerTimingParams (..)) -import PostgREST.SchemaCache (SchemaCache (..)) -import PostgREST.SchemaCache.Routine (Routine (..)) -import PostgREST.Version (docsVersion, prettyVersion) +import PostgREST.ApiRequest (Action (..), ApiRequest (..), + Mutation (..), Target (..)) +import PostgREST.AppState (AppState) +import PostgREST.Auth (AuthResult (..)) +import PostgREST.Config (AppConfig (..)) +import PostgREST.Config.PgVersion (PgVersion (..)) +import PostgREST.Error (Error) +import PostgREST.Query (DbHandler) +import PostgREST.Response.Performance (ServerMetric (..), + ServerTimingData, + renderServerTimingHeader) +import PostgREST.SchemaCache (SchemaCache (..)) +import PostgREST.SchemaCache.Routine (Routine (..)) +import PostgREST.Version (docsVersion, prettyVersion) import qualified Data.ByteString.Char8 as BS import qualified Data.List as L +import qualified Data.Map as Map (fromList) import qualified Network.HTTP.Types as HTTP import Protolude hiding (Handler) +import System.TimeIt (timeItT) type Handler = ExceptT Error @@ -155,8 +159,8 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@ liftEither . mapLeft Error.ApiRequestError $ ApiRequest.userApiRequest conf req body - let serverTimingParams = if configDbPlanEnabled then Just (ServerTimingParams { jwtDur = fromJust $ Auth.getJwtDur req }) else Nothing - handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache serverTimingParams + let jwtTiming = (SMJwt, if configDbPlanEnabled then Auth.getJwtDur req else Nothing) + handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache jwtTiming runDbHandler :: AppState.AppState -> SQL.IsolationLevel -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b runDbHandler appState isoLvl mode authenticated prepared handler = do @@ -170,63 +174,73 @@ runDbHandler appState isoLvl mode authenticated prepared handler = do liftEither resp -handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> PgVersion -> ApiRequest -> SchemaCache -> Maybe ServerTimingParams -> Handler IO Wai.Response -handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache serverTimingParams = +handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> PgVersion -> ApiRequest -> SchemaCache -> (ServerMetric, Maybe Double) -> Handler IO Wai.Response +handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache jwtTime = case (iAction, iTarget) of (ActionRead headersOnly, TargetIdent identifier) -> do - wrPlan <- liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq - resultSet <- runQuery roleIsoLvl (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq - pgrst <- liftEither $ Response.readResponse wrPlan headersOnly identifier apiReq resultSet serverTimingParams - return $ pgrstResponse pgrst + (planTime', wrPlan) <- withTiming $ liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq + (rsTime', resultSet) <- withTiming $ runQuery roleIsoLvl (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq + (renderTime', pgrst) <- withTiming $ liftEither $ Response.readResponse wrPlan headersOnly identifier apiReq resultSet + let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime] + return $ pgrstResponse metrics pgrst (ActionMutate MutationCreate, TargetIdent identifier) -> do - mrPlan <- liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache - resultSet <- runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf - pgrst <- liftEither $ Response.createResponse identifier mrPlan apiReq resultSet serverTimingParams - return $ pgrstResponse pgrst + (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache + (rsTime', resultSet) <- withTiming $ runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf + (renderTime', pgrst) <- withTiming $ liftEither $ Response.createResponse identifier mrPlan apiReq resultSet + let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime] + return $ pgrstResponse metrics pgrst (ActionMutate MutationUpdate, TargetIdent identifier) -> do - mrPlan <- liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache - resultSet <- runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.updateQuery mrPlan apiReq conf - pgrst <- liftEither $ Response.updateResponse mrPlan apiReq resultSet serverTimingParams - return $ pgrstResponse pgrst + (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache + (rsTime', resultSet) <- withTiming $ runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.updateQuery mrPlan apiReq conf + (renderTime', pgrst) <- withTiming $ liftEither $ Response.updateResponse mrPlan apiReq resultSet + let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime] + return $ pgrstResponse metrics pgrst (ActionMutate MutationSingleUpsert, TargetIdent identifier) -> do - mrPlan <- liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache - resultSet <- runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.singleUpsertQuery mrPlan apiReq conf - pgrst <- liftEither $ Response.singleUpsertResponse mrPlan apiReq resultSet serverTimingParams - return $ pgrstResponse pgrst + (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache + (rsTime', resultSet) <- withTiming $ runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.singleUpsertQuery mrPlan apiReq conf + (renderTime', pgrst) <- withTiming $ liftEither $ Response.singleUpsertResponse mrPlan apiReq resultSet + let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime] + return $ pgrstResponse metrics pgrst (ActionMutate MutationDelete, TargetIdent identifier) -> do - mrPlan <- liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache - resultSet <- runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf - pgrst <- liftEither $ Response.deleteResponse mrPlan apiReq resultSet serverTimingParams - return $ pgrstResponse pgrst + (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache + (rsTime', resultSet) <- withTiming $ runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf + (renderTime', pgrst) <- withTiming $ liftEither $ Response.deleteResponse mrPlan apiReq resultSet + let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime] + return $ pgrstResponse metrics pgrst (ActionInvoke invMethod, TargetProc identifier _) -> do - cPlan <- liftEither $ Plan.callReadPlan identifier conf sCache apiReq invMethod - resultSet <- runQuery (fromMaybe roleIsoLvl $ pdIsoLvl (Plan.crProc cPlan))(Plan.crTxMode cPlan) $ Query.invokeQuery (Plan.crProc cPlan) cPlan apiReq conf pgVer - pgrst <- liftEither $ Response.invokeResponse cPlan invMethod (Plan.crProc cPlan) apiReq resultSet serverTimingParams - return $ pgrstResponse pgrst + (planTime', cPlan) <- withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq invMethod + (rsTime', resultSet) <- withTiming $ runQuery (fromMaybe roleIsoLvl $ pdIsoLvl (Plan.crProc cPlan)) (Plan.crTxMode cPlan) $ Query.invokeQuery (Plan.crProc cPlan) cPlan apiReq conf pgVer + (renderTime', pgrst) <- withTiming $ liftEither $ Response.invokeResponse cPlan invMethod (Plan.crProc cPlan) apiReq resultSet + let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime] + return $ pgrstResponse metrics pgrst (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do - iPlan <- liftEither $ Plan.inspectPlan conf apiReq - oaiResult <- runQuery roleIsoLvl (Plan.ipTxmode iPlan) $ Query.openApiQuery sCache pgVer conf tSchema - pgrst <- liftEither $ Response.openApiResponse (T.decodeUtf8 prettyVersion, docsVersion) headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile - return $ pgrstResponse pgrst + (planTime', iPlan) <- withTiming $ liftEither $ Plan.inspectPlan conf apiReq + (rsTime', oaiResult) <- withTiming $ runQuery roleIsoLvl (Plan.ipTxmode iPlan) $ Query.openApiQuery sCache pgVer conf tSchema + (renderTime', pgrst) <- withTiming $ liftEither $ Response.openApiResponse (T.decodeUtf8 prettyVersion, docsVersion) headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile + let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime] + return $ pgrstResponse metrics pgrst (ActionInfo, TargetIdent identifier) -> do - pgrst <- liftEither $ Response.infoIdentResponse identifier sCache - return $ pgrstResponse pgrst + (renderTime', pgrst) <- withTiming $ liftEither $ Response.infoIdentResponse identifier sCache + let metrics = Map.fromList [(SMRender, renderTime'), jwtTime] + return $ pgrstResponse metrics pgrst (ActionInfo, TargetProc identifier _) -> do - cPlan <- liftEither $ Plan.callReadPlan identifier conf sCache apiReq ApiRequest.InvHead - pgrst <- liftEither $ Response.infoProcResponse (Plan.crProc cPlan) - return $ pgrstResponse pgrst + (planTime', cPlan) <- withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq ApiRequest.InvHead + (renderTime', pgrst) <- withTiming $ liftEither $ Response.infoProcResponse (Plan.crProc cPlan) + let metrics = Map.fromList [(SMPlan, planTime'), (SMRender, renderTime'), jwtTime] + return $ pgrstResponse metrics pgrst (ActionInfo, TargetDefaultSpec _) -> do - pgrst <- liftEither Response.infoRootResponse - return $ pgrstResponse pgrst + (renderTime', pgrst) <- withTiming $ liftEither Response.infoRootResponse + let metrics = Map.fromList [(SMRender, renderTime'), jwtTime] + return $ pgrstResponse metrics pgrst _ -> -- This is unreachable as the ApiRequest.hs rejects it before @@ -241,8 +255,16 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A Query.runPreReq conf query - pgrstResponse :: Response.PgrstResponse -> Wai.Response - pgrstResponse (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st hdrs bod + pgrstResponse :: ServerTimingData -> Response.PgrstResponse -> Wai.Response + pgrstResponse timings (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([renderServerTimingHeader timings | configDbPlanEnabled conf])) bod + + withTiming f = if configDbPlanEnabled conf + then do + (t, r) <- timeItT f + pure (Just t, r) + else do + r <- f + pure (Nothing, r) traceHeaderMiddleware :: AppConfig -> Wai.Middleware traceHeaderMiddleware AppConfig{configServerTraceHeader} app req respond = diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs index 2134f56608..fee977efca 100644 --- a/src/PostgREST/Response.hs +++ b/src/PostgREST/Response.hs @@ -15,7 +15,6 @@ module PostgREST.Response , readResponse , singleUpsertResponse , updateResponse - , ServerTimingParams(..) , PgrstResponse(..) ) where @@ -27,7 +26,6 @@ import Data.Text.Read (decimal) import qualified Network.HTTP.Types.Header as HTTP import qualified Network.HTTP.Types.Status as HTTP import qualified Network.HTTP.Types.URI as HTTP -import Numeric (showFFloat) import qualified PostgREST.Error as Error import qualified PostgREST.MediaType as MediaType @@ -62,21 +60,14 @@ import qualified PostgREST.SchemaCache.Routine as Routine import Protolude hiding (Handler, toS) import Protolude.Conv (toS) --- Parameters for server-timing header --- e.g "Server-Timing: jwt;dur=23.2" --- Add other durations like app, db, render later -newtype ServerTimingParams = ServerTimingParams { - jwtDur :: Double -} - data PgrstResponse = PgrstResponse { pgrstStatus :: HTTP.Status , pgrstHeaders :: [HTTP.Header] , pgrstBody :: LBS.ByteString } -readResponse :: WrappedReadPlan -> Bool -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Maybe ServerTimingParams -> Either Error.Error PgrstResponse -readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet serverTimingParams = +readResponse :: WrappedReadPlan -> Bool -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse +readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet = case resultSet of RSStandard{..} -> do let @@ -92,7 +83,6 @@ readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRe ] ++ contentTypeHeaders wrMedia ctxApiRequest ++ prefHeader - ++ serverTimingHeader serverTimingParams (ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status headers @@ -106,8 +96,8 @@ readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRe RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders wrMedia ctxApiRequest) $ LBS.fromStrict plan -createResponse :: QualifiedIdentifier -> MutateReadPlan -> ApiRequest -> ResultSet -> Maybe ServerTimingParams -> Either Error.Error PgrstResponse -createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet serverTimingParams = case resultSet of +createResponse :: QualifiedIdentifier -> MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse +createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet = case resultSet of RSStandard{..} -> do let pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;} @@ -127,8 +117,7 @@ createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctx ) , Just . RangeQuery.contentRangeH 1 0 $ if shouldCount preferCount then Just rsQueryTotal else Nothing - , prefHeader - ] ++ serverTimingHeader serverTimingParams + , prefHeader ] let status = HTTP.status201 let (headers', bod) = case preferRepresentation of @@ -143,15 +132,15 @@ createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctx RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan -updateResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Maybe ServerTimingParams -> Either Error.Error PgrstResponse -updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet serverTimingParams = case resultSet of +updateResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse +updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of RSStandard{..} -> do let contentRangeHeader = Just . RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $ if shouldCount preferCount then Just rsQueryTotal else Nothing prefHeader = prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction preferMissing preferHandling [] - headers = catMaybes [contentRangeHeader, prefHeader] ++ serverTimingHeader serverTimingParams + headers = catMaybes [contentRangeHeader, prefHeader] let (status, headers', body) = case preferRepresentation of @@ -166,19 +155,18 @@ updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Pre RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan -singleUpsertResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Maybe ServerTimingParams -> Either Error.Error PgrstResponse -singleUpsertResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet serverTimingParams = case resultSet of +singleUpsertResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse +singleUpsertResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of RSStandard {..} -> do let prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling [] - sTHeader = serverTimingHeader serverTimingParams cTHeader = contentTypeHeaders mrMedia ctxApiRequest let (status, headers, body) = case preferRepresentation of - Just Full -> (HTTP.status200, cTHeader ++ sTHeader ++ prefHeader, LBS.fromStrict rsBody) - Just None -> (HTTP.status204, sTHeader ++ prefHeader, mempty) - _ -> (HTTP.status204, sTHeader ++ prefHeader, mempty) + Just Full -> (HTTP.status200, cTHeader ++ prefHeader, LBS.fromStrict rsBody) + Just None -> (HTTP.status204, prefHeader, mempty) + _ -> (HTTP.status204, prefHeader, mempty) (ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status headers Right $ PgrstResponse ovStatus ovHeaders body @@ -186,15 +174,15 @@ singleUpsertResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferenc RSPlan plan -> Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan -deleteResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Maybe ServerTimingParams -> Either Error.Error PgrstResponse -deleteResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet serverTimingParams = case resultSet of +deleteResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse +deleteResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of RSStandard {..} -> do let contentRangeHeader = RangeQuery.contentRangeH 1 0 $ if shouldCount preferCount then Just rsQueryTotal else Nothing prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling [] - headers = contentRangeHeader : prefHeader ++ serverTimingHeader serverTimingParams + headers = contentRangeHeader : prefHeader let (status, headers', body) = case preferRepresentation of @@ -236,8 +224,8 @@ respondInfo allowHeader = let allOrigins = ("Access-Control-Allow-Origin", "*") in Right $ PgrstResponse HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty -invokeResponse :: CallReadPlan -> InvokeMethod -> Routine -> ApiRequest -> ResultSet -> Maybe ServerTimingParams -> Either Error.Error PgrstResponse -invokeResponse CallReadPlan{crMedia} invMethod proc ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet serverTimingParams = case resultSet of +invokeResponse :: CallReadPlan -> InvokeMethod -> Routine -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse +invokeResponse CallReadPlan{crMedia} invMethod proc ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet = case resultSet of RSStandard {..} -> do let (status, contentRange) = @@ -247,7 +235,7 @@ invokeResponse CallReadPlan{crMedia} invMethod proc ctxApiRequest@ApiRequest{iPr $ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal) else LBS.fromStrict rsBody prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing preferParameters preferCount preferTransaction Nothing preferHandling [] - headers = contentRange : prefHeader ++ serverTimingHeader serverTimingParams + headers = contentRange : prefHeader let (status', headers', body) = if Routine.funcReturnsVoid proc then @@ -301,15 +289,3 @@ addHeadersIfNotIncluded :: [HTTP.Header] -> [HTTP.Header] -> [HTTP.Header] addHeadersIfNotIncluded newHeaders initialHeaders = filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++ initialHeaders - --- | Adds the server-timing parameters to Server-Timing Header --- --- >>> :{ --- serverTimingHeader $ --- Just ServerTimingParams { jwtDur = 0.0000134 } --- :} --- [("Server-Timing","jwt;dur=13.4")] - -serverTimingHeader :: Maybe ServerTimingParams -> [HTTP.Header] -serverTimingHeader (Just ServerTimingParams{..}) = [("Server-Timing", "jwt;dur=" <> BS.pack (showFFloat (Just 1) (jwtDur*1000000) ""))] -serverTimingHeader Nothing = [] diff --git a/src/PostgREST/Response/Performance.hs b/src/PostgREST/Response/Performance.hs new file mode 100644 index 0000000000..dfc4c41ecf --- /dev/null +++ b/src/PostgREST/Response/Performance.hs @@ -0,0 +1,34 @@ +module PostgREST.Response.Performance + ( ServerMetric(..) + , ServerTimingData + , renderServerTimingHeader + ) +where +import qualified Data.ByteString.Char8 as BS +import qualified Data.Map as Map +import qualified Network.HTTP.Types as HTTP +import Numeric (showFFloat) +import Protolude + +data ServerMetric = + SMJwt + | SMRender + | SMPlan + | SMQuery + deriving (Show, Eq, Ord) +type ServerTimingData = Map ServerMetric (Maybe Double) + +-- | Render the Server-Timing header from a ServerTimingData +-- +-- >>> renderServerTimingHeader $ Map.fromList [(SMPlan, 0.1), (SMQuery, 0.2), (SMRender, 0.3), (SMJwt, 0.4)] +-- ("Server-Timing","jwt;dur=400000.0, render;dur=300000.0, plan;dur=100000.0, query;dur=200000.0") +renderServerTimingHeader :: ServerTimingData -> HTTP.Header +renderServerTimingHeader timingData = + ("Server-Timing", BS.intercalate ", " $ map renderTiming $ Map.toList timingData) +renderTiming :: (ServerMetric, Maybe Double) -> BS.ByteString +renderTiming (metric, time) = maybe "" (\x -> BS.concat [renderMetric metric, BS.pack $ ";dur=" <> showFFloat (Just 1) (x * 1000000) ""]) time + where + renderMetric SMPlan = "plan" + renderMetric SMQuery = "query" + renderMetric SMRender = "render" + renderMetric SMJwt = "jwt" diff --git a/test/io/test_io.py b/test/io/test_io.py index 72cc17eb29..a00a3fd7e7 100644 --- a/test/io/test_io.py +++ b/test/io/test_io.py @@ -1119,15 +1119,15 @@ def test_server_timing_jwt_should_decrease_on_subsequent_requests(defaultenv): ) with run(stdin=SECRET.encode(), env=env) as postgrest: - first_dur_text = postgrest.session.get( - "/authors_only", headers=headers - ).headers["Server-Timing"] - second_dur_text = postgrest.session.get( + first_timings = postgrest.session.get("/authors_only", headers=headers).headers[ + "Server-Timing" + ] + second_timings = postgrest.session.get( "/authors_only", headers=headers ).headers["Server-Timing"] - first_dur = float(first_dur_text[8:]) # skip "jwt;dur=" - second_dur = float(second_dur_text[8:]) + first_dur = parse_server_timings_header(first_timings)["jwt"] + second_dur = parse_server_timings_header(second_timings)["jwt"] # their difference should be atleast 300, implying # that JWT Caching is working as expected @@ -1172,15 +1172,15 @@ def test_server_timing_jwt_should_not_decrease_when_caching_disabled(defaultenv) with run(stdin=SECRET.encode(), env=env) as postgrest: warmup_req = postgrest.session.get("/authors_only", headers=headers) - first_dur_text = postgrest.session.get( - "/authors_only", headers=headers - ).headers["Server-Timing"] - second_dur_text = postgrest.session.get( + first_timings = postgrest.session.get("/authors_only", headers=headers).headers[ + "Server-Timing" + ] + second_timings = postgrest.session.get( "/authors_only", headers=headers ).headers["Server-Timing"] - first_dur = float(first_dur_text[8:]) # skip "jwt;dur=" - second_dur = float(second_dur_text[8:]) + first_dur = parse_server_timings_header(first_timings)["jwt"] + second_dur = parse_server_timings_header(second_timings)["jwt"] # their difference should be less than 150 # implying that token is not cached @@ -1201,15 +1201,15 @@ def test_jwt_cache_with_no_exp_claim(defaultenv): headers = jwtauthheader({"role": "postgrest_test_author"}, SECRET) # no exp with run(stdin=SECRET.encode(), env=env) as postgrest: - first_dur_text = postgrest.session.get( - "/authors_only", headers=headers - ).headers["Server-Timing"] - second_dur_text = postgrest.session.get( + first_timings = postgrest.session.get("/authors_only", headers=headers).headers[ + "Server-Timing" + ] + second_timings = postgrest.session.get( "/authors_only", headers=headers ).headers["Server-Timing"] - first_dur = float(first_dur_text[8:]) # skip "jwt;dur=" - second_dur = float(second_dur_text[8:]) + first_dur = parse_server_timings_header(first_timings)["jwt"] + second_dur = parse_server_timings_header(second_timings)["jwt"] # their difference should be atleast 300, implying # that JWT Caching is working as expected diff --git a/test/io/util.py b/test/io/util.py index 7d677c086f..59ba556438 100644 --- a/test/io/util.py +++ b/test/io/util.py @@ -40,3 +40,20 @@ def authheader(token): def jwtauthheader(claim, secret): "Authorization header with signed JWT." return authheader(jwt.encode(claim, secret)) + + +def parse_server_timings_header(header): + """Parse the Server-Timing header into a dict of metric names to values. + + The header is a comma-separated list of metrics, each of which has a name + and a duration. The duration may be followed by a semicolon and a list of + parameters, but we ignore those. + + See https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Server-Timing + """ + timings = {} + for timing in header.split(","): + name, duration_text, *_ = timing.split(";") + _, duration = duration_text.split("=") + timings[name] = float(duration) + return timings diff --git a/test/spec/Feature/Query/ServerTimingSpec.hs b/test/spec/Feature/Query/ServerTimingSpec.hs index 4ab8954a30..b894e78149 100644 --- a/test/spec/Feature/Query/ServerTimingSpec.hs +++ b/test/spec/Feature/Query/ServerTimingSpec.hs @@ -22,8 +22,7 @@ spec = `shouldRespondWith` [json|[{"id":6,"name":"Oscorp","referee":3,"auditor":4,"manager_id":6}]|] { matchStatus = 200 - , matchHeaders = [ matchContentTypeJson - , matchHeaderPresent "Server-Timing"] + , matchHeaders = matchContentTypeJson : map matchServerTimingHasTiming ["jwt", "plan", "query", "render"] } it "works with post request" $ @@ -33,8 +32,7 @@ spec = `shouldRespondWith` [json|[{"id":7,"name":"John","referee":null,"auditor":null,"manager_id":6}]|] { matchStatus = 201 - , matchHeaders = [ matchContentTypeJson - , matchHeaderPresent "Server-Timing"] + , matchHeaders = matchContentTypeJson : map matchServerTimingHasTiming ["jwt", "plan", "query", "render"] } it "works with patch request" $ @@ -43,8 +41,7 @@ spec = `shouldRespondWith` "" { matchStatus = 204 - , matchHeaders = [ matchHeaderAbsent hContentType - , matchHeaderPresent "Server-Timing" ] + , matchHeaders = matchHeaderAbsent hContentType : map matchServerTimingHasTiming ["jwt", "plan", "query", "render"] } it "works with put request" $ @@ -54,7 +51,7 @@ spec = `shouldRespondWith` [json| [ { "name": "Go", "rank": 19 } ]|] { matchStatus = 200 - , matchHeaders = [ matchHeaderPresent "Server-Timing" ] + , matchHeaders = map matchServerTimingHasTiming ["jwt", "plan", "query", "render"] } it "works with delete request" $ @@ -64,8 +61,7 @@ spec = `shouldRespondWith` "" { matchStatus = 204 - , matchHeaders = [ matchHeaderAbsent hContentType - , matchHeaderPresent "Server-Timing" ] + , matchHeaders = matchHeaderAbsent hContentType : map matchServerTimingHasTiming ["jwt", "plan", "query", "render"] } it "works with rpc call" $ @@ -75,5 +71,5 @@ spec = `shouldRespondWith` [json|{"x": 1, "y": 2}|] { matchStatus = 200 - , matchHeaders = [ matchHeaderPresent "Server-Timing" ] + , matchHeaders = map matchServerTimingHasTiming ["jwt", "plan", "query", "render"] } diff --git a/test/spec/SpecHelper.hs b/test/spec/SpecHelper.hs index 7bee04a95b..ec9695c5c2 100644 --- a/test/spec/SpecHelper.hs +++ b/test/spec/SpecHelper.hs @@ -24,6 +24,7 @@ import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Text.Heredoc +import Data.String (String) import PostgREST.Config (AppConfig (..), JSPathExp (..), LogLevel (..), @@ -58,11 +59,14 @@ matchHeaderAbsent name = MatchHeader $ \headers _body -> Just _ -> Just $ "unexpected header: " <> toS (original name) <> "\n" Nothing -> Nothing -matchHeaderPresent :: HeaderName -> MatchHeader -matchHeaderPresent name = MatchHeader $ \headers _body -> - case lookup name headers of - Just _ -> Nothing - Nothing -> Just $ "missing header: " <> toS (original name) <> "\n" +-- | Matches Server-Timing header has a well-formed metric with the given name +matchServerTimingHasTiming :: String -> MatchHeader +matchServerTimingHasTiming metric = MatchHeader $ \headers _body -> + case lookup "Server-Timing" headers of + Just hdr -> if hdr =~ (metric <> ";dur=[[:digit:]]+.[[:digit:]]+") + then Nothing + else Just $ "missing metric: " <> metric <> "\n" + Nothing -> Just "missing Server-Timing header\n" validateOpenApiResponse :: [Header] -> WaiSession () () validateOpenApiResponse headers = do