jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Andrei Dziahel
2023-10-12 09:55:30 -03:00
committed by GitHub
parent 056c748c5f
commit dc01c748ae
9 changed files with 180 additions and 129 deletions
Download Patch File Download Diff File Expand all files Collapse all files
CHANGELOG.md
+1
View File
@@ -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 - #2824, Fix range request with 0 rows and 0 offset return status 416 - @strengthless
## [11.2.1] - 2023-10-03 ## [11.2.1] - 2023-10-03
- #2983, Add more data to `Server-Timing` header - @develop7
### Fixed ### Fixed
postgrest.cabal
+1
View File
@@ -71,6 +71,7 @@ library
PostgREST.Response PostgREST.Response
PostgREST.Response.OpenAPI PostgREST.Response.OpenAPI
PostgREST.Response.GucHeader PostgREST.Response.GucHeader
PostgREST.Response.Performance
PostgREST.Version PostgREST.Version
other-modules: Paths_postgrest other-modules: Paths_postgrest
build-depends: base >= 4.9 && < 4.17 build-depends: base >= 4.9 && < 4.17
src/PostgREST/App.hs
+75 -53
View File
@@ -45,23 +45,27 @@ import qualified PostgREST.Plan as Plan
import qualified PostgREST.Query as Query import qualified PostgREST.Query as Query
import qualified PostgREST.Response as Response import qualified PostgREST.Response as Response
import PostgREST.ApiRequest (Action (..), ApiRequest (..), import PostgREST.ApiRequest (Action (..), ApiRequest (..),
Mutation (..), Target (..)) Mutation (..), Target (..))
import PostgREST.AppState (AppState) import PostgREST.AppState (AppState)
import PostgREST.Auth (AuthResult (..)) import PostgREST.Auth (AuthResult (..))
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
import PostgREST.Config.PgVersion (PgVersion (..)) import PostgREST.Config.PgVersion (PgVersion (..))
import PostgREST.Error (Error) import PostgREST.Error (Error)
import PostgREST.Query (DbHandler) import PostgREST.Query (DbHandler)
import PostgREST.Response (ServerTimingParams (..)) import PostgREST.Response.Performance (ServerMetric (..),
import PostgREST.SchemaCache (SchemaCache (..)) ServerTimingData,
import PostgREST.SchemaCache.Routine (Routine (..)) renderServerTimingHeader)
import PostgREST.Version (docsVersion, prettyVersion) import PostgREST.SchemaCache (SchemaCache (..))
import PostgREST.SchemaCache.Routine (Routine (..))
import PostgREST.Version (docsVersion, prettyVersion)
import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as BS
import qualified Data.List as L import qualified Data.List as L
import qualified Data.Map as Map (fromList)
import qualified Network.HTTP.Types as HTTP import qualified Network.HTTP.Types as HTTP
import Protolude hiding (Handler) import Protolude hiding (Handler)
import System.TimeIt (timeItT)
type Handler = ExceptT Error type Handler = ExceptT Error
@@ -155,8 +159,8 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@
liftEither . mapLeft Error.ApiRequestError $ liftEither . mapLeft Error.ApiRequestError $
ApiRequest.userApiRequest conf req body ApiRequest.userApiRequest conf req body
let serverTimingParams = if configDbPlanEnabled then Just (ServerTimingParams { jwtDur = fromJust $ Auth.getJwtDur req }) else Nothing let jwtTiming = (SMJwt, if configDbPlanEnabled then Auth.getJwtDur req else Nothing)
handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache serverTimingParams 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.AppState -> SQL.IsolationLevel -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
runDbHandler appState isoLvl mode authenticated prepared handler = do runDbHandler appState isoLvl mode authenticated prepared handler = do
@@ -170,63 +174,73 @@ runDbHandler appState isoLvl mode authenticated prepared handler = do
liftEither resp liftEither resp
handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> PgVersion -> ApiRequest -> SchemaCache -> Maybe ServerTimingParams -> Handler IO Wai.Response 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 serverTimingParams = handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache jwtTime =
case (iAction, iTarget) of case (iAction, iTarget) of
(ActionRead headersOnly, TargetIdent identifier) -> do (ActionRead headersOnly, TargetIdent identifier) -> do
wrPlan <- liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq (planTime', wrPlan) <- withTiming $ liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq
resultSet <- runQuery roleIsoLvl (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq (rsTime', resultSet) <- withTiming $ runQuery roleIsoLvl (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq
pgrst <- liftEither $ Response.readResponse wrPlan headersOnly identifier apiReq resultSet serverTimingParams (renderTime', pgrst) <- withTiming $ liftEither $ Response.readResponse wrPlan headersOnly identifier apiReq resultSet
return $ pgrstResponse pgrst let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime]
return $ pgrstResponse metrics pgrst
(ActionMutate MutationCreate, TargetIdent identifier) -> do (ActionMutate MutationCreate, TargetIdent identifier) -> do
mrPlan <- liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache
resultSet <- runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf (rsTime', resultSet) <- withTiming $ runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf
pgrst <- liftEither $ Response.createResponse identifier mrPlan apiReq resultSet serverTimingParams (renderTime', pgrst) <- withTiming $ liftEither $ Response.createResponse identifier mrPlan apiReq resultSet
return $ pgrstResponse pgrst let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime]
return $ pgrstResponse metrics pgrst
(ActionMutate MutationUpdate, TargetIdent identifier) -> do (ActionMutate MutationUpdate, TargetIdent identifier) -> do
mrPlan <- liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache
resultSet <- runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.updateQuery mrPlan apiReq conf (rsTime', resultSet) <- withTiming $ runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.updateQuery mrPlan apiReq conf
pgrst <- liftEither $ Response.updateResponse mrPlan apiReq resultSet serverTimingParams (renderTime', pgrst) <- withTiming $ liftEither $ Response.updateResponse mrPlan apiReq resultSet
return $ pgrstResponse pgrst let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime]
return $ pgrstResponse metrics pgrst
(ActionMutate MutationSingleUpsert, TargetIdent identifier) -> do (ActionMutate MutationSingleUpsert, TargetIdent identifier) -> do
mrPlan <- liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache
resultSet <- runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.singleUpsertQuery mrPlan apiReq conf (rsTime', resultSet) <- withTiming $ runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.singleUpsertQuery mrPlan apiReq conf
pgrst <- liftEither $ Response.singleUpsertResponse mrPlan apiReq resultSet serverTimingParams (renderTime', pgrst) <- withTiming $ liftEither $ Response.singleUpsertResponse mrPlan apiReq resultSet
return $ pgrstResponse pgrst let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime]
return $ pgrstResponse metrics pgrst
(ActionMutate MutationDelete, TargetIdent identifier) -> do (ActionMutate MutationDelete, TargetIdent identifier) -> do
mrPlan <- liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache
resultSet <- runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf (rsTime', resultSet) <- withTiming $ runQuery roleIsoLvl (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf
pgrst <- liftEither $ Response.deleteResponse mrPlan apiReq resultSet serverTimingParams (renderTime', pgrst) <- withTiming $ liftEither $ Response.deleteResponse mrPlan apiReq resultSet
return $ pgrstResponse pgrst let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime]
return $ pgrstResponse metrics pgrst
(ActionInvoke invMethod, TargetProc identifier _) -> do (ActionInvoke invMethod, TargetProc identifier _) -> do
cPlan <- liftEither $ Plan.callReadPlan identifier conf sCache apiReq invMethod (planTime', cPlan) <- withTiming $ 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 (rsTime', resultSet) <- withTiming $ 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 (renderTime', pgrst) <- withTiming $ liftEither $ Response.invokeResponse cPlan invMethod (Plan.crProc cPlan) apiReq resultSet
return $ pgrstResponse pgrst let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime]
return $ pgrstResponse metrics pgrst
(ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
iPlan <- liftEither $ Plan.inspectPlan conf apiReq (planTime', iPlan) <- withTiming $ liftEither $ Plan.inspectPlan conf apiReq
oaiResult <- runQuery roleIsoLvl (Plan.ipTxmode iPlan) $ Query.openApiQuery sCache pgVer conf tSchema (rsTime', oaiResult) <- withTiming $ 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 (renderTime', pgrst) <- withTiming $ liftEither $ Response.openApiResponse (T.decodeUtf8 prettyVersion, docsVersion) headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile
return $ pgrstResponse pgrst let metrics = Map.fromList [(SMPlan, planTime'), (SMQuery, rsTime'), (SMRender, renderTime'), jwtTime]
return $ pgrstResponse metrics pgrst
(ActionInfo, TargetIdent identifier) -> do (ActionInfo, TargetIdent identifier) -> do
pgrst <- liftEither $ Response.infoIdentResponse identifier sCache (renderTime', pgrst) <- withTiming $ liftEither $ Response.infoIdentResponse identifier sCache
return $ pgrstResponse pgrst let metrics = Map.fromList [(SMRender, renderTime'), jwtTime]
return $ pgrstResponse metrics pgrst
(ActionInfo, TargetProc identifier _) -> do (ActionInfo, TargetProc identifier _) -> do
cPlan <- liftEither $ Plan.callReadPlan identifier conf sCache apiReq ApiRequest.InvHead (planTime', cPlan) <- withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq ApiRequest.InvHead
pgrst <- liftEither $ Response.infoProcResponse (Plan.crProc cPlan) (renderTime', pgrst) <- withTiming $ liftEither $ Response.infoProcResponse (Plan.crProc cPlan)
return $ pgrstResponse pgrst let metrics = Map.fromList [(SMPlan, planTime'), (SMRender, renderTime'), jwtTime]
return $ pgrstResponse metrics pgrst
(ActionInfo, TargetDefaultSpec _) -> do (ActionInfo, TargetDefaultSpec _) -> do
pgrst <- liftEither Response.infoRootResponse (renderTime', pgrst) <- withTiming $ liftEither Response.infoRootResponse
return $ pgrstResponse pgrst let metrics = Map.fromList [(SMRender, renderTime'), jwtTime]
return $ pgrstResponse metrics pgrst
_ -> _ ->
-- This is unreachable as the ApiRequest.hs rejects it before -- 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.runPreReq conf
query query
pgrstResponse :: Response.PgrstResponse -> Wai.Response pgrstResponse :: ServerTimingData -> Response.PgrstResponse -> Wai.Response
pgrstResponse (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st hdrs bod 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 -> Wai.Middleware
traceHeaderMiddleware AppConfig{configServerTraceHeader} app req respond = traceHeaderMiddleware AppConfig{configServerTraceHeader} app req respond =
src/PostgREST/Response.hs
+19 -43
View File
@@ -15,7 +15,6 @@ module PostgREST.Response
, readResponse , readResponse
, singleUpsertResponse , singleUpsertResponse
, updateResponse , updateResponse
, ServerTimingParams(..)
, PgrstResponse(..) , PgrstResponse(..)
) where ) where
@@ -27,7 +26,6 @@ import Data.Text.Read (decimal)
import qualified Network.HTTP.Types.Header as HTTP import qualified Network.HTTP.Types.Header as HTTP
import qualified Network.HTTP.Types.Status as HTTP import qualified Network.HTTP.Types.Status as HTTP
import qualified Network.HTTP.Types.URI as HTTP import qualified Network.HTTP.Types.URI as HTTP
import Numeric (showFFloat)
import qualified PostgREST.Error as Error import qualified PostgREST.Error as Error
import qualified PostgREST.MediaType as MediaType import qualified PostgREST.MediaType as MediaType
@@ -62,21 +60,14 @@ import qualified PostgREST.SchemaCache.Routine as Routine
import Protolude hiding (Handler, toS) import Protolude hiding (Handler, toS)
import Protolude.Conv (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 { data PgrstResponse = PgrstResponse {
pgrstStatus :: HTTP.Status pgrstStatus :: HTTP.Status
, pgrstHeaders :: [HTTP.Header] , pgrstHeaders :: [HTTP.Header]
, pgrstBody :: LBS.ByteString , pgrstBody :: LBS.ByteString
} }
readResponse :: WrappedReadPlan -> Bool -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Maybe ServerTimingParams -> Either Error.Error PgrstResponse readResponse :: WrappedReadPlan -> Bool -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet serverTimingParams = readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet =
case resultSet of case resultSet of
RSStandard{..} -> do RSStandard{..} -> do
let let
@@ -92,7 +83,6 @@ readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRe
] ]
++ contentTypeHeaders wrMedia ctxApiRequest ++ contentTypeHeaders wrMedia ctxApiRequest
++ prefHeader ++ prefHeader
++ serverTimingHeader serverTimingParams
(ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status headers (ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status headers
@@ -106,8 +96,8 @@ readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRe
RSPlan plan -> RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders wrMedia ctxApiRequest) $ LBS.fromStrict 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 -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet serverTimingParams = case resultSet of createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet = case resultSet of
RSStandard{..} -> do RSStandard{..} -> do
let let
pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;} pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;}
@@ -127,8 +117,7 @@ createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctx
) )
, Just . RangeQuery.contentRangeH 1 0 $ , Just . RangeQuery.contentRangeH 1 0 $
if shouldCount preferCount then Just rsQueryTotal else Nothing if shouldCount preferCount then Just rsQueryTotal else Nothing
, prefHeader , prefHeader ]
] ++ serverTimingHeader serverTimingParams
let status = HTTP.status201 let status = HTTP.status201
let (headers', bod) = case preferRepresentation of let (headers', bod) = case preferRepresentation of
@@ -143,15 +132,15 @@ createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctx
RSPlan plan -> RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
updateResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Maybe ServerTimingParams -> Either Error.Error PgrstResponse updateResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet serverTimingParams = case resultSet of updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
RSStandard{..} -> do RSStandard{..} -> do
let let
contentRangeHeader = contentRangeHeader =
Just . RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $ Just . RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $
if shouldCount preferCount then Just rsQueryTotal else Nothing if shouldCount preferCount then Just rsQueryTotal else Nothing
prefHeader = prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction preferMissing preferHandling [] prefHeader = prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction preferMissing preferHandling []
headers = catMaybes [contentRangeHeader, prefHeader] ++ serverTimingHeader serverTimingParams headers = catMaybes [contentRangeHeader, prefHeader]
let let
(status, headers', body) = case preferRepresentation of (status, headers', body) = case preferRepresentation of
@@ -166,19 +155,18 @@ updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Pre
RSPlan plan -> RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
singleUpsertResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Maybe ServerTimingParams -> Either Error.Error PgrstResponse singleUpsertResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
singleUpsertResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet serverTimingParams = case resultSet of singleUpsertResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
RSStandard {..} -> do RSStandard {..} -> do
let let
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling [] prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling []
sTHeader = serverTimingHeader serverTimingParams
cTHeader = contentTypeHeaders mrMedia ctxApiRequest cTHeader = contentTypeHeaders mrMedia ctxApiRequest
let (status, headers, body) = let (status, headers, body) =
case preferRepresentation of case preferRepresentation of
Just Full -> (HTTP.status200, cTHeader ++ sTHeader ++ prefHeader, LBS.fromStrict rsBody) Just Full -> (HTTP.status200, cTHeader ++ prefHeader, LBS.fromStrict rsBody)
Just None -> (HTTP.status204, sTHeader ++ prefHeader, mempty) Just None -> (HTTP.status204, prefHeader, mempty)
_ -> (HTTP.status204, sTHeader ++ prefHeader, mempty) _ -> (HTTP.status204, prefHeader, mempty)
(ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status headers (ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status headers
Right $ PgrstResponse ovStatus ovHeaders body Right $ PgrstResponse ovStatus ovHeaders body
@@ -186,15 +174,15 @@ singleUpsertResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferenc
RSPlan plan -> RSPlan plan ->
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
deleteResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Maybe ServerTimingParams -> Either Error.Error PgrstResponse deleteResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
deleteResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet serverTimingParams = case resultSet of deleteResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
RSStandard {..} -> do RSStandard {..} -> do
let let
contentRangeHeader = contentRangeHeader =
RangeQuery.contentRangeH 1 0 $ RangeQuery.contentRangeH 1 0 $
if shouldCount preferCount then Just rsQueryTotal else Nothing if shouldCount preferCount then Just rsQueryTotal else Nothing
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling [] prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling []
headers = contentRangeHeader : prefHeader ++ serverTimingHeader serverTimingParams headers = contentRangeHeader : prefHeader
let (status, headers', body) = let (status, headers', body) =
case preferRepresentation of case preferRepresentation of
@@ -236,8 +224,8 @@ respondInfo allowHeader =
let allOrigins = ("Access-Control-Allow-Origin", "*") in let allOrigins = ("Access-Control-Allow-Origin", "*") in
Right $ PgrstResponse HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty Right $ PgrstResponse HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty
invokeResponse :: CallReadPlan -> InvokeMethod -> Routine -> ApiRequest -> ResultSet -> Maybe ServerTimingParams -> Either Error.Error PgrstResponse invokeResponse :: CallReadPlan -> InvokeMethod -> Routine -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
invokeResponse CallReadPlan{crMedia} invMethod proc ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet serverTimingParams = case resultSet of invokeResponse CallReadPlan{crMedia} invMethod proc ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet = case resultSet of
RSStandard {..} -> do RSStandard {..} -> do
let let
(status, contentRange) = (status, contentRange) =
@@ -247,7 +235,7 @@ invokeResponse CallReadPlan{crMedia} invMethod proc ctxApiRequest@ApiRequest{iPr
$ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal) $ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal)
else LBS.fromStrict rsBody else LBS.fromStrict rsBody
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing preferParameters preferCount preferTransaction Nothing preferHandling [] prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing preferParameters preferCount preferTransaction Nothing preferHandling []
headers = contentRange : prefHeader ++ serverTimingHeader serverTimingParams headers = contentRange : prefHeader
let (status', headers', body) = let (status', headers', body) =
if Routine.funcReturnsVoid proc then if Routine.funcReturnsVoid proc then
@@ -301,15 +289,3 @@ addHeadersIfNotIncluded :: [HTTP.Header] -> [HTTP.Header] -> [HTTP.Header]
addHeadersIfNotIncluded newHeaders initialHeaders = addHeadersIfNotIncluded newHeaders initialHeaders =
filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++ filter (\(nk, _) -> isNothing $ find (\(ik, _) -> ik == nk) initialHeaders) newHeaders ++
initialHeaders 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 = []
src/PostgREST/Response/Performance.hs
+34
View File
@@ -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"
test/io/test_io.py
+18 -18
View File
@@ -1119,15 +1119,15 @@ def test_server_timing_jwt_should_decrease_on_subsequent_requests(defaultenv):
) )
with run(stdin=SECRET.encode(), env=env) as postgrest: with run(stdin=SECRET.encode(), env=env) as postgrest:
first_dur_text = postgrest.session.get( first_timings = postgrest.session.get("/authors_only", headers=headers).headers[
"/authors_only", headers=headers "Server-Timing"
).headers["Server-Timing"] ]
second_dur_text = postgrest.session.get( second_timings = postgrest.session.get(
"/authors_only", headers=headers "/authors_only", headers=headers
).headers["Server-Timing"] ).headers["Server-Timing"]
first_dur = float(first_dur_text[8:]) # skip "jwt;dur=" first_dur = parse_server_timings_header(first_timings)["jwt"]
second_dur = float(second_dur_text[8:]) second_dur = parse_server_timings_header(second_timings)["jwt"]
# their difference should be atleast 300, implying # their difference should be atleast 300, implying
# that JWT Caching is working as expected # 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: with run(stdin=SECRET.encode(), env=env) as postgrest:
warmup_req = postgrest.session.get("/authors_only", headers=headers) warmup_req = postgrest.session.get("/authors_only", headers=headers)
first_dur_text = postgrest.session.get( first_timings = postgrest.session.get("/authors_only", headers=headers).headers[
"/authors_only", headers=headers "Server-Timing"
).headers["Server-Timing"] ]
second_dur_text = postgrest.session.get( second_timings = postgrest.session.get(
"/authors_only", headers=headers "/authors_only", headers=headers
).headers["Server-Timing"] ).headers["Server-Timing"]
first_dur = float(first_dur_text[8:]) # skip "jwt;dur=" first_dur = parse_server_timings_header(first_timings)["jwt"]
second_dur = float(second_dur_text[8:]) second_dur = parse_server_timings_header(second_timings)["jwt"]
# their difference should be less than 150 # their difference should be less than 150
# implying that token is not cached # 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 headers = jwtauthheader({"role": "postgrest_test_author"}, SECRET) # no exp
with run(stdin=SECRET.encode(), env=env) as postgrest: with run(stdin=SECRET.encode(), env=env) as postgrest:
first_dur_text = postgrest.session.get( first_timings = postgrest.session.get("/authors_only", headers=headers).headers[
"/authors_only", headers=headers "Server-Timing"
).headers["Server-Timing"] ]
second_dur_text = postgrest.session.get( second_timings = postgrest.session.get(
"/authors_only", headers=headers "/authors_only", headers=headers
).headers["Server-Timing"] ).headers["Server-Timing"]
first_dur = float(first_dur_text[8:]) # skip "jwt;dur=" first_dur = parse_server_timings_header(first_timings)["jwt"]
second_dur = float(second_dur_text[8:]) second_dur = parse_server_timings_header(second_timings)["jwt"]
# their difference should be atleast 300, implying # their difference should be atleast 300, implying
# that JWT Caching is working as expected # that JWT Caching is working as expected
test/io/util.py
+17
View File
@@ -40,3 +40,20 @@ def authheader(token):
def jwtauthheader(claim, secret): def jwtauthheader(claim, secret):
"Authorization header with signed JWT." "Authorization header with signed JWT."
return authheader(jwt.encode(claim, secret)) 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
test/spec/Feature/Query/ServerTimingSpec.hs
+6 -10
View File
@@ -22,8 +22,7 @@ spec =
`shouldRespondWith` `shouldRespondWith`
[json|[{"id":6,"name":"Oscorp","referee":3,"auditor":4,"manager_id":6}]|] [json|[{"id":6,"name":"Oscorp","referee":3,"auditor":4,"manager_id":6}]|]
{ matchStatus = 200 { matchStatus = 200
, matchHeaders = [ matchContentTypeJson , matchHeaders = matchContentTypeJson : map matchServerTimingHasTiming ["jwt", "plan", "query", "render"]
, matchHeaderPresent "Server-Timing"]
} }
it "works with post request" $ it "works with post request" $
@@ -33,8 +32,7 @@ spec =
`shouldRespondWith` `shouldRespondWith`
[json|[{"id":7,"name":"John","referee":null,"auditor":null,"manager_id":6}]|] [json|[{"id":7,"name":"John","referee":null,"auditor":null,"manager_id":6}]|]
{ matchStatus = 201 { matchStatus = 201
, matchHeaders = [ matchContentTypeJson , matchHeaders = matchContentTypeJson : map matchServerTimingHasTiming ["jwt", "plan", "query", "render"]
, matchHeaderPresent "Server-Timing"]
} }
it "works with patch request" $ it "works with patch request" $
@@ -43,8 +41,7 @@ spec =
`shouldRespondWith` `shouldRespondWith`
"" ""
{ matchStatus = 204 { matchStatus = 204
, matchHeaders = [ matchHeaderAbsent hContentType , matchHeaders = matchHeaderAbsent hContentType : map matchServerTimingHasTiming ["jwt", "plan", "query", "render"]
, matchHeaderPresent "Server-Timing" ]
} }
it "works with put request" $ it "works with put request" $
@@ -54,7 +51,7 @@ spec =
`shouldRespondWith` `shouldRespondWith`
[json| [ { "name": "Go", "rank": 19 } ]|] [json| [ { "name": "Go", "rank": 19 } ]|]
{ matchStatus = 200 { matchStatus = 200
, matchHeaders = [ matchHeaderPresent "Server-Timing" ] , matchHeaders = map matchServerTimingHasTiming ["jwt", "plan", "query", "render"]
} }
it "works with delete request" $ it "works with delete request" $
@@ -64,8 +61,7 @@ spec =
`shouldRespondWith` `shouldRespondWith`
"" ""
{ matchStatus = 204 { matchStatus = 204
, matchHeaders = [ matchHeaderAbsent hContentType , matchHeaders = matchHeaderAbsent hContentType : map matchServerTimingHasTiming ["jwt", "plan", "query", "render"]
, matchHeaderPresent "Server-Timing" ]
} }
it "works with rpc call" $ it "works with rpc call" $
@@ -75,5 +71,5 @@ spec =
`shouldRespondWith` `shouldRespondWith`
[json|{"x": 1, "y": 2}|] [json|{"x": 1, "y": 2}|]
{ matchStatus = 200 { matchStatus = 200
, matchHeaders = [ matchHeaderPresent "Server-Timing" ] , matchHeaders = map matchServerTimingHasTiming ["jwt", "plan", "query", "render"]
} }
test/spec/SpecHelper.hs
+9 -5
View File
@@ -24,6 +24,7 @@ import Test.Hspec.Wai
import Test.Hspec.Wai.JSON import Test.Hspec.Wai.JSON
import Text.Heredoc import Text.Heredoc
import Data.String (String)
import PostgREST.Config (AppConfig (..), import PostgREST.Config (AppConfig (..),
JSPathExp (..), JSPathExp (..),
LogLevel (..), LogLevel (..),
@@ -58,11 +59,14 @@ matchHeaderAbsent name = MatchHeader $ \headers _body ->
Just _ -> Just $ "unexpected header: " <> toS (original name) <> "\n" Just _ -> Just $ "unexpected header: " <> toS (original name) <> "\n"
Nothing -> Nothing Nothing -> Nothing
matchHeaderPresent :: HeaderName -> MatchHeader -- | Matches Server-Timing header has a well-formed metric with the given name
matchHeaderPresent name = MatchHeader $ \headers _body -> matchServerTimingHasTiming :: String -> MatchHeader
case lookup name headers of matchServerTimingHasTiming metric = MatchHeader $ \headers _body ->
Just _ -> Nothing case lookup "Server-Timing" headers of
Nothing -> Just $ "missing header: " <> toS (original name) <> "\n" 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 :: [Header] -> WaiSession () ()
validateOpenApiResponse headers = do validateOpenApiResponse headers = do