From 7640de34e28806d7e1a3db5bfa42348c66d8ba99 Mon Sep 17 00:00:00 2001 From: Laurence Isla Date: Tue, 28 Nov 2023 18:26:56 -0500 Subject: [PATCH] refactor: use a data type instead of Map for Server Timing --- src/PostgREST/App.hs | 52 ++++++++++----------------- src/PostgREST/Response/Performance.hs | 46 ++++++++++++------------ 2 files changed, 41 insertions(+), 57 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 27fbe2db9f..233cbf7900 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -51,16 +51,14 @@ 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.Response.Performance (ServerTiming (..), + serverTimingHeader) 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 qualified Network.Socket as NS import Protolude hiding (Handler) @@ -150,12 +148,8 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@ liftEither . mapLeft Error.ApiRequestError $ ApiRequest.userApiRequest conf req body sCache - let - jwtAndParseTiming = - [(SMJwt, if configServerTimingEnabled then Auth.getJwtDur req else Nothing) - ,(SMParse, parseTime)] - - handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache jwtAndParseTiming + let jwtTime = if configServerTimingEnabled then Auth.getJwtDur req else Nothing + handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache jwtTime parseTime runDbHandler :: AppState.AppState -> AppConfig -> SQL.IsolationLevel -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b runDbHandler appState config isoLvl mode authenticated prepared handler = do @@ -169,73 +163,63 @@ runDbHandler appState config isoLvl mode authenticated prepared handler = do liftEither resp -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 jwtAndParseTime = +handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> PgVersion -> ApiRequest -> SchemaCache -> Maybe Double -> Maybe Double -> Handler IO Wai.Response +handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache jwtTime parseTime = case (iAction, iTarget) of (ActionRead headersOnly, TargetIdent identifier) -> do (planTime', wrPlan) <- withTiming $ liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl Nothing (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq (respTime', pgrst) <- withTiming $ liftEither $ Response.readResponse wrPlan headersOnly identifier apiReq resultSet - let metrics = Map.fromList $ [(SMPlan, planTime'), (SMTransaction, txTime'), (SMResp, respTime')] ++ jwtAndParseTime - return $ pgrstResponse metrics pgrst + return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionMutate MutationCreate, TargetIdent identifier) -> do (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl Nothing (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf (respTime', pgrst) <- withTiming $ liftEither $ Response.createResponse identifier mrPlan apiReq resultSet - let metrics = Map.fromList $ [(SMPlan, planTime'), (SMTransaction, txTime'), (SMResp, respTime')] ++ jwtAndParseTime - return $ pgrstResponse metrics pgrst + return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionMutate MutationUpdate, TargetIdent identifier) -> do (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl Nothing (Plan.mrTxMode mrPlan) $ Query.updateQuery mrPlan apiReq conf (respTime', pgrst) <- withTiming $ liftEither $ Response.updateResponse mrPlan apiReq resultSet - let metrics = Map.fromList $ [(SMPlan, planTime'), (SMTransaction, txTime'), (SMResp, respTime')] ++ jwtAndParseTime - return $ pgrstResponse metrics pgrst + return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionMutate MutationSingleUpsert, TargetIdent identifier) -> do (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl Nothing (Plan.mrTxMode mrPlan) $ Query.singleUpsertQuery mrPlan apiReq conf (respTime', pgrst) <- withTiming $ liftEither $ Response.singleUpsertResponse mrPlan apiReq resultSet - let metrics = Map.fromList $ [(SMPlan, planTime'), (SMTransaction, txTime'), (SMResp, respTime')] ++ jwtAndParseTime - return $ pgrstResponse metrics pgrst + return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionMutate MutationDelete, TargetIdent identifier) -> do (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl Nothing (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf (respTime', pgrst) <- withTiming $ liftEither $ Response.deleteResponse mrPlan apiReq resultSet - let metrics = Map.fromList $ [(SMPlan, planTime'), (SMTransaction, txTime'), (SMResp, respTime')] ++ jwtAndParseTime - return $ pgrstResponse metrics pgrst + return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionInvoke invMethod, TargetProc identifier _) -> do (planTime', cPlan) <- withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq invMethod (txTime', resultSet) <- withTiming $ runQuery (fromMaybe roleIsoLvl $ pdIsoLvl (Plan.crProc cPlan)) (pdTimeout $ Plan.crProc cPlan) (Plan.crTxMode cPlan) $ Query.invokeQuery (Plan.crProc cPlan) cPlan apiReq conf pgVer (respTime', pgrst) <- withTiming $ liftEither $ Response.invokeResponse cPlan invMethod (Plan.crProc cPlan) apiReq resultSet - let metrics = Map.fromList $ [(SMPlan, planTime'), (SMTransaction, txTime'), (SMResp, respTime')] ++ jwtAndParseTime - return $ pgrstResponse metrics pgrst + return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do (planTime', iPlan) <- withTiming $ liftEither $ Plan.inspectPlan apiReq (txTime', oaiResult) <- withTiming $ runQuery roleIsoLvl Nothing (Plan.ipTxmode iPlan) $ Query.openApiQuery sCache pgVer conf tSchema (respTime', pgrst) <- withTiming $ liftEither $ Response.openApiResponse (T.decodeUtf8 prettyVersion, docsVersion) headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile - let metrics = Map.fromList $ [(SMPlan, planTime'), (SMTransaction, txTime'), (SMResp, respTime')] ++ jwtAndParseTime - return $ pgrstResponse metrics pgrst + return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionInfo, TargetIdent identifier) -> do (respTime', pgrst) <- withTiming $ liftEither $ Response.infoIdentResponse identifier sCache - let metrics = Map.fromList $ (SMResp, respTime'):jwtAndParseTime - return $ pgrstResponse metrics pgrst + return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst (ActionInfo, TargetProc identifier _) -> do (planTime', cPlan) <- withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq ApiRequest.InvHead (respTime', pgrst) <- withTiming $ liftEither $ Response.infoProcResponse (Plan.crProc cPlan) - let metrics = Map.fromList $ [(SMPlan, planTime'), (SMResp, respTime')] ++ jwtAndParseTime - return $ pgrstResponse metrics pgrst + return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' Nothing respTime') pgrst (ActionInfo, TargetDefaultSpec _) -> do (respTime', pgrst) <- withTiming $ liftEither Response.infoRootResponse - let metrics = Map.fromList $ (SMResp, respTime'):jwtAndParseTime - return $ pgrstResponse metrics pgrst + return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst _ -> -- This is unreachable as the ApiRequest.hs rejects it before @@ -250,8 +234,8 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A Query.runPreReq conf query - pgrstResponse :: ServerTimingData -> Response.PgrstResponse -> Wai.Response - pgrstResponse timings (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([renderServerTimingHeader timings | configServerTimingEnabled conf])) bod + pgrstResponse :: ServerTiming -> Response.PgrstResponse -> Wai.Response + pgrstResponse timing (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([serverTimingHeader timing | configServerTimingEnabled conf])) bod withTiming = calcTiming $ configServerTimingEnabled conf diff --git a/src/PostgREST/Response/Performance.hs b/src/PostgREST/Response/Performance.hs index f8531d6ef5..3e6287ed8c 100644 --- a/src/PostgREST/Response/Performance.hs +++ b/src/PostgREST/Response/Performance.hs @@ -1,36 +1,36 @@ module PostgREST.Response.Performance - ( ServerMetric(..) - , ServerTimingData - , renderServerTimingHeader + ( ServerTiming (..) + , serverTimingHeader ) 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 - | SMParse - | SMPlan - | SMTransaction - | SMResp - deriving (Show, Eq, Ord) -type ServerTimingData = Map ServerMetric (Maybe Double) +data ServerTiming = + ServerTiming + { jwt :: Maybe Double + , parse :: Maybe Double + , plan :: Maybe Double + , transaction :: Maybe Double + , response :: Maybe Double + } + deriving (Show) -- | Render the Server-Timing header from a ServerTimingData -- --- >>> renderServerTimingHeader $ Map.fromList [(SMPlan, Just 0.1), (SMTransaction, Just 0.2), (SMResp, Just 0.3), (SMJwt, Just 0.4), (SMParse, Just 0.5)] +-- >>> serverTimingHeader ServerTiming { plan=Just 0.1, transaction=Just 0.2, response=Just 0.3, jwt=Just 0.4, parse=Just 0.5} -- ("Server-Timing","jwt;dur=400000.0, parse;dur=500000.0, plan;dur=100000.0, transaction;dur=200000.0, response;dur=300000.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 +serverTimingHeader :: ServerTiming -> HTTP.Header +serverTimingHeader timing = + ("Server-Timing", renderTiming) where - renderMetric SMJwt = "jwt" - renderMetric SMParse = "parse" - renderMetric SMPlan = "plan" - renderMetric SMTransaction = "transaction" - renderMetric SMResp = "response" + renderMetric metric = maybe "" (\dur -> BS.concat [metric, BS.pack $ ";dur=" <> showFFloat (Just 1) (dur * 1000000) ""]) + renderTiming = BS.intercalate ", " $ (\(k, v) -> renderMetric k (v timing)) <$> + [ ("jwt", jwt) + , ("parse", parse) + , ("plan", plan) + , ("transaction", transaction) + , ("response", response) + ]