feat: add more perf counters to Server-Timing (#2983)

2023-10-12 09:55:30 -03:00
parent 056c748c5f
commit dc01c748ae
9 changed files with 180 additions and 129 deletions
@@ -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 =
@@ -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 = []
@@ -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"