feat: add Server-Timing header with JWT duration

CHANGELOG.md

@@ -9,6 +9,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
  - #1614, Add `db-pool-automatic-recovery` configuration to disable connection retrying - @taimoorzaeem
  - #2492, Allow full response control when raising exceptions - @taimoorzaeem, @laurenceisla
+ - #2771, Add `Server-Timing` header with JWT duration - @taimoorzaeem
 
 ### Fixed
 

postgrest.cabal

@@ -114,6 +114,7 @@ library
                     , swagger2                  >= 2.4 && < 2.9
                     , text                      >= 1.2.2 && < 1.3
                     , time                      >= 1.6 && < 1.12
+                    , timeit                    >= 2.0 && < 2.1
                     , unordered-containers      >= 0.2.8 && < 0.3
                     , vault                     >= 0.3.1.5 && < 0.4
                     , vector                    >= 0.11 && < 0.14
@@ -203,22 +204,23 @@ test-suite spec
                       Feature.Query.DeleteSpec
                       Feature.Query.EmbedDisambiguationSpec
                       Feature.Query.EmbedInnerJoinSpec
-                      Feature.Query.PlanSpec
+                      Feature.Query.ErrorSpec
                       Feature.Query.HtmlRawOutputSpec
                       Feature.Query.InsertSpec
                       Feature.Query.JsonOperatorSpec
                       Feature.Query.MultipleSchemaSpec
-                      Feature.Query.ErrorSpec
+                      Feature.Query.NullsStripSpec
                       Feature.Query.PgSafeUpdateSpec
+                      Feature.Query.PlanSpec
                       Feature.Query.PostGISSpec
                       Feature.Query.QueryLimitedSpec
                       Feature.Query.QuerySpec
                       Feature.Query.RangeSpec
                       Feature.Query.RawOutputTypesSpec
                       Feature.Query.RelatedQueriesSpec
                       Feature.Query.RpcSpec
+                      Feature.Query.ServerTimingSpec
                       Feature.Query.SingularSpec
-                      Feature.Query.NullsStrip
                       Feature.Query.SpreadQueriesSpec
                       Feature.Query.UnicodeSpec
                       Feature.Query.UpdateSpec

src/PostgREST/App.hs

@@ -52,6 +52,7 @@ 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)
@@ -150,7 +151,8 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@
     liftEither . mapLeft Error.ApiRequestError $
       ApiRequest.userApiRequest conf req body
 
-  handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache
+  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
 
 runDbHandler :: AppState.AppState -> SQL.IsolationLevel -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
 runDbHandler appState isoLvl mode authenticated prepared handler = do
@@ -164,38 +166,38 @@ runDbHandler appState isoLvl mode authenticated prepared handler = do
 
   liftEither resp
 
-handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> PgVersion -> ApiRequest -> SchemaCache -> Handler IO Wai.Response
-handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache =
+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 =
   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
-      return $ Response.readResponse wrPlan headersOnly identifier apiReq resultSet
+      return $ Response.readResponse wrPlan headersOnly identifier apiReq resultSet serverTimingParams
 
     (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
-      return $ Response.createResponse identifier mrPlan apiReq resultSet
+      return $ Response.createResponse identifier mrPlan apiReq resultSet serverTimingParams
 
     (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
-      return $ Response.updateResponse mrPlan apiReq resultSet
+      return $ Response.updateResponse mrPlan apiReq resultSet serverTimingParams
 
     (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
-      return $ Response.singleUpsertResponse mrPlan apiReq resultSet
+      return $ Response.singleUpsertResponse mrPlan apiReq resultSet serverTimingParams
 
     (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
-      return $ Response.deleteResponse mrPlan apiReq resultSet
+      return $ Response.deleteResponse mrPlan apiReq resultSet serverTimingParams
 
     (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
-      return $ Response.invokeResponse cPlan invMethod (Plan.crProc cPlan) apiReq resultSet
+      return $ Response.invokeResponse cPlan invMethod (Plan.crProc cPlan) apiReq resultSet serverTimingParams
 
     (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
       iPlan <- liftEither $ Plan.inspectPlan conf apiReq

src/PostgREST/Auth.hs

@@ -14,6 +14,7 @@ very simple authentication system inside the PostgreSQL database.
 module PostgREST.Auth
   ( AuthResult (..)
   , getResult
+  , getJwtDur
   , getRole
   , middleware
   ) where
@@ -37,6 +38,7 @@ import Data.Either.Combinators (mapLeft)
 import Data.List               (lookup)
 import Data.Time.Clock         (UTCTime)
 import System.IO.Unsafe        (unsafePerformIO)
+import System.TimeIt           (timeItT)
 
 import PostgREST.AppState (AppState, getConfig, getTime)
 import PostgREST.Config   (AppConfig (..), JSPath, JSPathExp (..))
@@ -102,13 +104,19 @@ middleware appState app req respond = do
   conf <- getConfig appState
   time <- getTime appState
 
-  let token = fromMaybe "" $ Wai.extractBearerAuth =<< lookup HTTP.hAuthorization (Wai.requestHeaders req)
-  authResult <- runExceptT $
-    parseToken conf (LBS.fromStrict token) time >>=
-    parseClaims conf
+  let token  = fromMaybe "" $ Wai.extractBearerAuth =<< lookup HTTP.hAuthorization (Wai.requestHeaders req)
+      parseJwt = runExceptT $ parseToken conf (LBS.fromStrict token) time >>= parseClaims conf
+
+  if configDbPlanEnabled conf
+    then do
+      (dur,authResult) <- timeItT parseJwt
+      let req' = req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult & Vault.insert jwtDurKey dur }
+      app req' respond
+    else do
+      authResult <- parseJwt
+      let req' = req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult }
+      app req' respond
 
-  let req' = req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult }
-  app req' respond
 
 authResultKey :: Vault.Key (Either Error AuthResult)
 authResultKey = unsafePerformIO Vault.newKey
@@ -117,5 +125,12 @@ authResultKey = unsafePerformIO Vault.newKey
 getResult :: Wai.Request -> Maybe (Either Error AuthResult)
 getResult = Vault.lookup authResultKey . Wai.vault
 
+jwtDurKey :: Vault.Key Double
+jwtDurKey = unsafePerformIO Vault.newKey
+{-# NOINLINE jwtDurKey #-}
+
+getJwtDur :: Wai.Request -> Maybe Double
+getJwtDur =  Vault.lookup jwtDurKey . Wai.vault
+
 getRole :: Wai.Request -> Maybe BS.ByteString
 getRole req = authRole <$> (rightToMaybe =<< getResult req)