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

test/spec/Feature/Query/ServerTimingSpec.hs

@@ -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"]
           }

test/spec/SpecHelper.hs

@@ -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