feat: add server-trace-header config for tracing

test/spec/Feature/ObservabilitySpec.hs

@@ -0,0 +1,34 @@
+module Feature.ObservabilitySpec where
+
+import Network.Wai (Application)
+
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+
+import Protolude
+
+spec :: SpecWith ((), Application)
+spec =
+  describe "Observability" $ do
+    it "includes the server trace header on the response" $ do
+      request methodHead "/"
+          [ ("X-Request-Id", "1") ]
+          ""
+        `shouldRespondWith`
+          ""
+          { matchHeaders = [ "X-Request-Id" <:> "1"] }
+
+      request methodHead "/projects"
+          [ ("X-Request-Id", "2") ]
+          ""
+        `shouldRespondWith`
+          ""
+          { matchHeaders = [ "X-Request-Id" <:> "2"] }
+
+      request methodHead "/rpc/add_them?a=2&b=4"
+          [ ("X-Request-Id", "3") ]
+          ""
+        `shouldRespondWith`
+          ""
+          { matchHeaders = [ "X-Request-Id" <:> "3"] }

test/spec/Main.hs

@@ -10,7 +10,7 @@ import Data.List.NonEmpty (toList)
 import Test.Hspec
 
 import PostgREST.App             (postgrest)
-import PostgREST.Config          (AppConfig (..), LogLevel (..))
+import PostgREST.Config          (AppConfig (..))
 import PostgREST.Config.Database (queryPgVersion)
 import PostgREST.SchemaCache     (querySchemaCache)
 import Protolude                 hiding (toList, toS)
@@ -29,6 +29,7 @@ import qualified Feature.ConcurrentSpec
 import qualified Feature.CorsSpec
 import qualified Feature.ExtraSearchPathSpec
 import qualified Feature.LegacyGucsSpec
+import qualified Feature.ObservabilitySpec
 import qualified Feature.OpenApi.DisabledOpenApiSpec
 import qualified Feature.OpenApi.IgnorePrivOpenApiSpec
 import qualified Feature.OpenApi.OpenApiSpec
@@ -83,7 +84,7 @@ main = do
       AppState.putSchemaCache appState (Just baseSchemaCache)
       when (isJust $ configDbRootSpec config) $
         AppState.putJsonDbS appState $ toS $ JSON.encode baseSchemaCache
-      return ((), postgrest LogCrit appState $ pure ())
+      return ((), postgrest config appState $ pure ())
 
     -- For tests that run with a different SchemaCache(depends on configSchemas)
     appDbs config = do
@@ -96,7 +97,7 @@ main = do
       AppState.putSchemaCache appState (Just customSchemaCache)
       when (isJust $ configDbRootSpec config) $
         AppState.putJsonDbS appState $ toS $ JSON.encode baseSchemaCache
-      return ((), postgrest LogCrit appState $ pure ())
+      return ((), postgrest config appState $ pure ())
 
   let withApp              = app testCfg
       maxRowsApp           = app testMaxRowsCfg
@@ -117,6 +118,7 @@ main = do
       testCfgLegacyGucsApp = app testCfgLegacyGucs
       planEnabledApp       = app testPlanEnabledCfg
       pgSafeUpdateApp      = app testPgSafeUpdateEnabledCfg
+      obsApp               = app testObservabilityCfg
 
       extraSearchPathApp   = appDbs testCfgExtraSearchPath
       unicodeApp           = appDbs testUnicodeCfg
@@ -247,6 +249,10 @@ main = do
     parallel $ before pgSafeUpdateApp $
       describe "Feature.Query.PgSafeUpdateSpec.spec" Feature.Query.PgSafeUpdateSpec.spec
 
+    -- this test runs with server-trace-header set
+    parallel $ before obsApp $
+      describe "Feature.ObservabilitySpec.spec" Feature.ObservabilitySpec.spec
+
     -- Note: the rollback tests can not run in parallel, because they test persistance and
     -- this results in race conditions
 

test/spec/SpecHelper.hs

@@ -10,7 +10,7 @@ import           Data.Scientific        (toRealFloat)
 import qualified Data.Set               as S
 
 import Data.Aeson           (Value (..), decode, encode)
-import Data.CaseInsensitive (CI (..), original)
+import Data.CaseInsensitive (CI (..), mk, original)
 import Data.List            (lookup)
 import Data.List.NonEmpty   (fromList)
 import Network.Wai.Test     (SResponse (simpleBody, simpleHeaders, simpleStatus))
@@ -103,6 +103,7 @@ baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in
   , configRawMediaTypes         = []
   , configServerHost            = "localhost"
   , configServerPort            = 3000
+  , configServerTraceHeader     = Nothing
   , configServerUnixSocket      = Nothing
   , configServerUnixSocketMode  = 432
   , configDbTxAllowOverride     = True
@@ -203,6 +204,9 @@ testCfgLegacyGucs = baseCfg { configDbUseLegacyGucs = False }
 testPgSafeUpdateEnabledCfg :: AppConfig
 testPgSafeUpdateEnabledCfg = baseCfg { configDbPreRequest = Just $ QualifiedIdentifier "test" "load_safeupdate" }
 
+testObservabilityCfg :: AppConfig
+testObservabilityCfg = baseCfg { configServerTraceHeader = Just $ mk "X-Request-Id" }
+
 analyzeTable :: Text -> IO ()
 analyzeTable tableName =
   void $ readProcess "psql" ["--set", "ON_ERROR_STOP=1", "-a", "-c", toS $ "ANALYZE test.\"" <> tableName <> "\""] []