From 650137dc00d115669f5f3fbfda041c408d74b0da Mon Sep 17 00:00:00 2001
From: awjchen <awjchen@users.noreply.github.com>
Date: Tue, 2 May 2023 01:21:08 -0600
Subject: [PATCH] server: respect `X-B3-Sampled` header when `X-B3-TraceId` is
 not present

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9009
GitOrigin-RevId: 7a4565bcada4f6249927ed0cbfbe42401a9a7968
---
 server/src-lib/Hasura/Server/App.hs | 24 +++++++++++++++---------
 1 file changed, 15 insertions(+), 9 deletions(-)

diff --git a/server/src-lib/Hasura/Server/App.hs b/server/src-lib/Hasura/Server/App.hs
index 5aa6dfd20d3..c0d734861b2 100644
--- a/server/src-lib/Hasura/Server/App.hs
+++ b/server/src-lib/Hasura/Server/App.hs
@@ -317,20 +317,26 @@ mkSpockAction appStateRef qErrEncoder qErrModifier apiHandler = do
                     Tracing.traceIdFromHex $ Char8.replicate 16 '0' <> rawTraceId
                 | otherwise ->
                     Nothing
-    for traceIdMaybe $ \traceId -> do
-      freshSpanId <- Tracing.randomSpanId
-      let parentSpanId = Tracing.spanIdFromHex =<< lookup "X-B3-SpanId" headers
-          samplingState = Tracing.samplingStateFromHeader $ lookup "X-B3-Sampled" headers
-      pure $ Tracing.TraceContext traceId freshSpanId parentSpanId samplingState
+
+    case traceIdMaybe of
+      Just traceId -> do
+        freshSpanId <- Tracing.randomSpanId
+        let parentSpanId = Tracing.spanIdFromHex =<< lookup "X-B3-SpanId" headers
+            samplingState = Tracing.samplingStateFromHeader $ lookup "X-B3-Sampled" headers
+        pure $ Tracing.TraceContext traceId freshSpanId parentSpanId samplingState
+      Nothing -> do
+        freshTraceId <- Tracing.randomTraceId
+        freshSpanId <- Tracing.randomSpanId
+        let samplingState = Tracing.samplingStateFromHeader $ lookup "X-B3-Sampled" headers
+        pure $ Tracing.TraceContext freshTraceId freshSpanId Nothing samplingState
 
   let runTrace ::
         forall m1 a1.
-        (MonadIO m1, MonadTrace m1) =>
+        (MonadTrace m1) =>
         m1 a1 ->
         m1 a1
-      runTrace = case tracingCtx of
-        Nothing -> Tracing.newTrace appEnvTraceSamplingPolicy (fromString (B8.unpack pathInfo))
-        Just ctx -> Tracing.newTraceWith ctx appEnvTraceSamplingPolicy (fromString (B8.unpack pathInfo))
+      runTrace =
+        Tracing.newTraceWith tracingCtx appEnvTraceSamplingPolicy (fromString (B8.unpack pathInfo))
 
   let getInfo parsedRequest = do
         authenticationResp <- lift (resolveUserInfo (_lsLogger appEnvLoggers) appEnvManager headers acAuthMode parsedRequest)