From 9e792f2e61b2ebca82fa635dfe0b5c81d9740d4b Mon Sep 17 00:00:00 2001
From: Phil Freeman <paf31@cantab.net>
Date: Mon, 31 Aug 2020 15:05:04 -0700
Subject: [PATCH] server: Use event trigger name as tracing span name

---
 server/src-lib/Hasura/Eventing/EventTrigger.hs  | 17 +++++++++--------
 .../src-lib/Hasura/Eventing/ScheduledTrigger.hs | 13 +++++++------
 2 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/server/src-lib/Hasura/Eventing/EventTrigger.hs b/server/src-lib/Hasura/Eventing/EventTrigger.hs
index 5b37e7e416d..e92253bfaa3 100644
--- a/server/src-lib/Hasura/Eventing/EventTrigger.hs
+++ b/server/src-lib/Hasura/Eventing/EventTrigger.hs
@@ -204,13 +204,7 @@ processEventQueue logger logenv httpMgr pool getSchemaCache eeCtx@EventEngineCtx
       eventsNext <- LA.withAsync popEventsBatch $ \eventsNextA -> do
         -- process approximately in order, minding HASURA_GRAPHQL_EVENTS_HTTP_POOL_SIZE:
         forM_ events $ \event -> do
-          tracingCtx <- liftIO (Tracing.extractEventContext (eEvent event))
-          let runTraceT = maybe
-                Tracing.runTraceT
-                Tracing.runTraceTInContext
-                tracingCtx
           t <- processEvent event
-            & runTraceT "process event"
             & withEventEngineCtx eeCtx
             & flip runReaderT (logger, httpMgr)
             & LA.async
@@ -247,11 +241,18 @@ processEventQueue logger logenv httpMgr pool getSchemaCache eeCtx@EventEngineCtx
          , MonadReader r io
          , Has HTTP.Manager r
          , Has (L.Logger L.Hasura) r
-         , Tracing.MonadTrace io
+         , Tracing.HasReporter io
          )
       => Event -> io ()
     processEvent e = do
       cache <- liftIO getSchemaCache
+      
+      tracingCtx <- liftIO (Tracing.extractEventContext (eEvent e))
+      let runTraceT = maybe
+            Tracing.runTraceT
+            Tracing.runTraceTInContext
+            tracingCtx
+      
       let meti = getEventTriggerInfoFromEvent cache e
       case meti of
         Nothing -> do
@@ -264,7 +265,7 @@ processEventQueue logger logenv httpMgr pool getSchemaCache eeCtx@EventEngineCtx
             -- For such an event, we unlock the event and retry after a minute
             setRetry e (addUTCTime 60 currentTime)
           >>= flip onLeft logQErr
-        Just eti -> do
+        Just eti -> runTraceT ("Event trigger: " <> unNonEmptyText (unTriggerName (etiName eti))) do
           let webhook = T.unpack $ wciCachedValue $ etiWebhookInfo eti
               retryConf = etiRetryConf eti
               timeoutSeconds = fromMaybe defaultTimeoutSeconds (rcTimeoutSec retryConf)
diff --git a/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs b/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs
index bc7e00b1bae..a3446b261d8 100644
--- a/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs
+++ b/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs
@@ -376,7 +376,7 @@ processCronEvents logger logEnv httpMgr pgpool getSC lockedCronEvents = do
                                        ctiRetryConf
                                        ctiHeaders
                                        ctiComment
-            finally <- Tracing.runTraceT "scheduled event" . runExceptT $
+            finally <- runExceptT $
               runReaderT (processScheduledEvent logEnv pgpool scheduledEvent CronScheduledEvent) (logger, httpMgr)
             removeEventFromLockedEvents id' lockedCronEvents
             either logInternalError pure finally
@@ -431,9 +431,9 @@ processStandAloneEvents env logger logEnv httpMgr pgpool lockedStandAloneEvents
                                                         retryConf
                                                         headerInfo'
                                                         comment
-                finally <- Tracing.runTraceT "scheduled event" . runExceptT $
+                finally <- runExceptT $
                   runReaderT (processScheduledEvent logEnv pgpool scheduledEvent StandAloneEvent) $
-                                 (logger, httpMgr)
+                    (logger, httpMgr)
                 removeEventFromLockedEvents id' lockedStandAloneEvents
                 either logInternalError pure finally
 
@@ -468,15 +468,14 @@ processScheduledEvent ::
   , HasVersion
   , MonadIO m
   , MonadError QErr m
-  , Tracing.MonadTrace m
+  , Tracing.HasReporter m
   )
   => LogEnvHeaders
   -> Q.PGPool
   -> ScheduledEventFull
   -> ScheduledEventType
   -> m ()
-processScheduledEvent
-  logEnv pgpool se@ScheduledEventFull {..} type' = do
+processScheduledEvent logEnv pgpool se@ScheduledEventFull {..} type' = Tracing.runTraceT traceNote do
   currentTime <- liftIO getCurrentTime
   if convertDuration (diffUTCTime currentTime sefScheduledTime)
     > unNonNegativeDiffTime (strcToleranceSeconds sefRetryConf)
@@ -499,6 +498,8 @@ processScheduledEvent
         (processError pgpool se decodedHeaders type' webhookReqBodyJson)
         (processSuccess pgpool se decodedHeaders type' webhookReqBodyJson)
         res
+  where 
+    traceNote = "Scheduled trigger" <> foldMap ((": " <>) . unNonEmptyText . unTriggerName) sefName
 
 processError
   :: (MonadIO m, MonadError QErr m)