feat: add more perf counters to Server-Timing (#2983)
This commit is contained in:
Andrei Dziahel
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
+75
-53
@@ -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 =
|
||||
|
||||
+19
-43
@@ -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"
|
||||
+18
-18
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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"]
|
||||
}
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user