Fix the thread id for all trace events for a request

Summary: We fix the thread id to simplify the trace visualization, as otherwise the events become scattered in the trace viewer and in any case precise thread tracing is not a goal

Reviewed By: nhawkes

Differential Revision: D56230557

fbshipit-source-id: 0e1d63403f28270f99730e27b7d6dc2bdb549909

glean/glass/Glean/Glass/Config.hs

@@ -36,7 +36,7 @@ defaultRefreshFreq = minutes 5
 defaultListDatabasesRetry :: Int
 defaultListDatabasesRetry = 5
 
-defaultWelcomeMessage :: Config -> Text
+defaultWelcomeMessage :: Config a -> Text
 defaultWelcomeMessage Config{..} = mconcat
           [ "glass"
           , ": port " <> textShow listenPort

glean/glass/Glean/Glass/Env.hs

@@ -17,7 +17,8 @@ module Glean.Glass.Env
     updateWelcomeMessage,
 
     -- * Session resources
-    Env(..),
+    Env,
+    Env'(..),
     IndexBackend(..),
   ) where
 
@@ -39,10 +40,10 @@ import Glean.Glass.Base (RepoMapping)
 import Glean.Glass.Repos (GleanDBInfo)
 import Glean.Glass.SnapshotBackend ( SnapshotBackend(..) )
 import Glean.Glass.SourceControl
-import Glean.Glass.Tracing (GlassTracer)
+import Glean.Glass.Tracing (Tracer, GlassTrace)
 
 -- | Init-time configuration
-data Config = Config
+data Config trace = Config
   { listenPort :: Int
   , configKey :: Text
   , gleanService :: Glean.Service
@@ -54,34 +55,36 @@ data Config = Config
   , numWorkerThreads :: Maybe Int
   , snapshotBackend :: EventBaseDataplane -> Some SnapshotBackend
   , sourceControl :: EventBaseDataplane -> IO (Some SourceControl)
-  , tracer :: GlassTracer
-  , welcomeMessage :: EventBaseDataplane -> Config -> IO Text
+  , tracer :: Tracer trace
+  , welcomeMessage :: forall a. EventBaseDataplane -> Config a -> IO Text
   }
 
 setSnapshotBackend
-  :: (EventBaseDataplane -> Some SnapshotBackend) -> Config -> Config
+  :: (EventBaseDataplane -> Some SnapshotBackend) -> Config a -> Config a
 setSnapshotBackend snapshotBackend config =
   config { snapshotBackend = snapshotBackend }
 
 setSourceControl
   :: (EventBaseDataplane -> IO (Some SourceControl))
-  -> Config -> Config
+  -> Config a -> Config a
 setSourceControl sourceControl config =
   config { sourceControl = sourceControl }
 
-setTracer :: GlassTracer -> Config -> Config
-setTracer tracer config = config{ tracer = tracer }
+setTracer :: Tracer trace -> Config a -> Config trace
+setTracer tracer' Config{..}= Config{ tracer = tracer', .. }
 
 updateWelcomeMessage
-  :: ( (EventBaseDataplane -> Config -> IO Text)
-      -> EventBaseDataplane -> Config -> IO Text)
-  -> Config
-  -> Config
+  :: ( forall a. (EventBaseDataplane -> Config a -> IO Text)
+      -> EventBaseDataplane -> Config a -> IO Text)
+  -> Config a
+  -> Config a
 updateWelcomeMessage f config =
   config{ welcomeMessage = f (welcomeMessage config)}
 
 -- | Read-only, scoped, dynamic resources.
-data Env = Env
+type Env = Env' GlassTrace
+
+data Env' trace = Env
   { evp :: EventBaseDataplane
   , cfgapi :: ConfigAPI
   , logger :: Logger
@@ -93,7 +96,7 @@ data Env = Env
   , gleanDB :: Maybe Glean.Repo -- if provided, use as target Glean DB
   , repoMapping :: RepoMapping
   , sourceControl :: Some SourceControl
-  , tracer :: GlassTracer
+  , tracer :: Tracer trace
   }
 
 -- | A backend to create incremental databases

glean/glass/Glean/Glass/Handler.hs

@@ -136,7 +136,7 @@ import Glean.Glass.SnapshotBackend
     SnapshotStatus() )
 import qualified Glean.Glass.SnapshotBackend as Snapshot
 import Glean.Glass.SymbolKind (findSymbolKind)
-import Glean.Glass.Env (Env (tracer))
+import Glean.Glass.Env (Env' (tracer))
 import Glean.Glass.Tracing (GlassTracer, traceSpan)
 
 -- | Runner for methods that are keyed by a file path

glean/glass/Glean/Glass/Main.hs

@@ -16,7 +16,10 @@ module Glean.Glass.Main
   ) where
 
 
-import Control.Trace (traceMsg)
+import Control.Concurrent (myThreadId)
+import Control.Trace (traceMsg, (>$<))
+import Data.Hashable (hash)
+import Data.List (stripPrefix)
 import Facebook.Service ( runFacebookService' )
 import Facebook.Fb303 ( fb303Handler, withFb303 )
 import Thrift.Channel (Header)
@@ -56,30 +59,34 @@ import Glean.Glass.GlassService.Service ( GlassServiceCommand(..) )
 import Glean.Glass.Types
   ( GlassException (GlassException, glassException_reasons),
     GlassExceptionReason (GlassExceptionReason_exactRevisionNotAvailable))
-import Glean.Glass.Env (Env(tracer))
+import Glean.Glass.Env (Env'(tracer), Env)
 import Glean.Glass.Tracer ( isTracingEnabled )
-import Glean.Glass.Tracing (GlassTrace(TraceCommand))
+import Glean.Glass.Tracing
+  (GlassTrace(TraceCommand), GlassTraceWithId (GlassTraceWithId))
 
 kThriftCacheNoCache :: Text
 kThriftCacheNoCache = "nocache"
 
 -- | Ok, go.
-mainWith :: Parser (Glass.Config -> Glass.Config) -> IO ()
+mainWith
+  :: Parser (Glass.Config GlassTraceWithId -> Glass.Config GlassTraceWithId)
+  -> IO ()
 mainWith = withGlass runGlass
 
-type Server = Glass.Env -> Glass.Config -> IO ()
+type Server trace = Glass.Env' trace -> Glass.Config trace -> IO ()
 
 -- | Set up the resources we'll need
-withGlass :: Server -> Parser (Glass.Config -> Glass.Config) -> IO ()
+withGlass
+  :: Server trace -> Parser (Glass.Config trace -> Glass.Config trace) -> IO ()
 withGlass f backendsP =
   withOptions (Glass.options backendsP) $ \config@Glass.Config{..} ->
   withEnv config Nothing $ \env -> f env config
 
 -- | Construct a server environment
 withEnv
-  :: Glass.Config
+  :: Glass.Config trace
   -> Maybe Glean.Repo
-  -> (Glass.Env -> IO a)
+  -> (Glass.Env' trace -> IO a)
   -> IO a
 withEnv Glass.Config{..} gleanDB f =
   withEventBaseDataplane $ \evp ->
@@ -115,7 +122,7 @@ indexBackend b = Glass.IndexBackend $ case backendKind b of
   BackendThrift b -> Just b
 
 -- | Kick off the server
-runGlass :: Server
+runGlass :: Server GlassTraceWithId
 runGlass res@Glass.Env{fb303, evp} conf@Glass.Config{..} = do
 
   logInfo =<< welcomeMessage evp conf
@@ -145,18 +152,30 @@ withCurrentRepoMapping env0 fn = do
   current <- getRepoMapping
   fn (env0 { Glass.repoMapping = current })
 
-withRequestTracing :: Env -> (Env -> IO b) -> IO b
+withRequestTracing :: Env' GlassTraceWithId -> (Env -> IO b) -> IO b
 withRequestTracing env k = do
   enabled <- isTracingEnabled
-  k $ if enabled then env else env { tracer = mempty }
+  if enabled
+    then do
+      -- Fix the trace id for this request traces.
+      -- Since every request is handled by a fresh new thread,
+      -- we reuse thread ids as trace ids
+      tid <- tidToIndex <$> myThreadId
+      k env{tracer = GlassTraceWithId tid >$< tracer env}
+    else k env { tracer = mempty }
+  where
+    tidToIndex tid = case stripPrefix "ThreadId " (show tid) of
+      Just n | [(i, "")] <- reads n -> i
+      _ -> hash tid -- should be unreachable
 
 -- Actual glass service handler, types from glass.thrift
 -- TODO: snapshot the env, rather than passing in the mutable fields
 --
-glassHandler :: Glass.Env -> GlassServiceCommand r -> IO r
+glassHandler :: Glass.Env' GlassTraceWithId -> GlassServiceCommand r -> IO r
 glassHandler env0 cmd =
-  withCurrentRepoMapping env0 $ \env1 ->
-  withRequestTracing env1 $ \env ->
+  withRequestTracing env0 $ \env1 ->
+  withCurrentRepoMapping env1 $ \env ->
+
   traceMsg (tracer env) (TraceCommand cmd) $ case cmd of
   SuperFacebookService r -> fb303Handler (Glass.fb303 env) r
 

glean/glass/Glean/Glass/Options.hs

@@ -26,10 +26,11 @@ import Glean.Glass.SnapshotBackend
 import Glean.Glass.SourceControl
 import Glean.Glass.Config (defaultWelcomeMessage)
 
-options :: Parser (Glass.Config -> Glass.Config) -> ParserInfo Glass.Config
+options
+  :: Parser (Glass.Config a -> Glass.Config a) -> ParserInfo (Glass.Config a)
 options mod = info (helper <*> mod <*> configParser) fullDesc
 
-configParser :: Parser Glass.Config
+configParser :: Parser (Glass.Config a)
 configParser = do
   gleanService <- Glean.options
   listenPort <- portParser
@@ -40,8 +41,10 @@ configParser = do
   snapshotBackend <- pure (const $ Some NilSnapshotBackend)
   sourceControl <- pure (const (return (Some NilSourceControl)))
   tracer <- pure mempty
-  welcomeMessage <- pure (pure (pure . defaultWelcomeMessage))
-  return Glass.Config{configKey = Glass.defaultConfigKey, ..}
+  return $ Glass.Config{
+        configKey = Glass.defaultConfigKey,
+        welcomeMessage = pure (pure . defaultWelcomeMessage),
+         ..}
 
 portParser :: Parser Int
 portParser = option auto $ mconcat

glean/glass/Glean/Glass/Tracing.hs

@@ -9,7 +9,10 @@
 {-# OPTIONS_GHC -Wno-unused-matches #-}
 module Glean.Glass.Tracing
   ( GlassTrace(..)
+  , GlassTraceWithId(..)
   , GlassTracer
+  , TraceId
+  , Tracer
   , traceSpan
   , glassTraceEvent
   ) where
@@ -27,19 +30,29 @@ import Data.Binary.Builder ( toLazyByteString )
 
 type GlassTracer = Tracer GlassTrace
 
-traceSpan :: GlassTracer -> Text -> IO a -> IO a
-traceSpan tracer span = traceMsg tracer (TraceSpan span Nothing)
+type TraceId = Int
+
+data GlassTraceWithId = GlassTraceWithId
+  { traceId :: !TraceId
+  , traceEvent :: !GlassTrace
+  }
 
 data GlassTrace where
   TraceCommand :: forall r . GlassServiceCommand r -> GlassTrace
   TraceSpan :: !Text -> Maybe Text -> GlassTrace
 
-glassTraceEvent :: GlassTrace -> (Text, Maybe Text)
-glassTraceEvent (TraceSpan event args) = (event, args)
-glassTraceEvent (TraceCommand cmd) = case cmd of
-  Glass.SuperFacebookService r -> ("SuperFacebookService", Nothing)
+traceSpan :: GlassTracer -> Text -> IO a -> IO a
+traceSpan tracer span = traceMsg tracer (TraceSpan span Nothing)
+
+{-# INLINE glassTraceEvent #-}
+glassTraceEvent :: GlassTraceWithId -> (Text, Int, Maybe Text)
+glassTraceEvent (GlassTraceWithId tid (TraceSpan event args)) =
+  (event, tid, args)
+glassTraceEvent (GlassTraceWithId tid (TraceCommand cmd)) = case cmd of
+  Glass.SuperFacebookService r -> ("SuperFacebookService", tid, Nothing)
   Glass.DocumentSymbolListX DocumentSymbolsRequest{..} opts ->
     ( "DocumentSymbolListX"
+    , tid
     , json $ pairs $
        "filepath" .= documentSymbolsRequest_filepath <>
        "repository" .= documentSymbolsRequest_repository <>
@@ -48,34 +61,35 @@ glassTraceEvent (TraceCommand cmd) = case cmd of
     )
   Glass.DocumentSymbolIndex DocumentSymbolsRequest{..} opts ->
     ("DocumentSymbolIndex"
+    , tid
     , json $ pairs $
        "filepath" .= documentSymbolsRequest_filepath <>
        "repository" .= documentSymbolsRequest_repository <>
        "revision" .= requestOptions_revision opts <>
        "exact" .= requestOptions_exact_revision opts
     )
   Glass.FindReferences r opts ->
-    ( "FindReferences" , json $ toEncoding r)
+    ( "FindReferences", tid, json $ toEncoding r)
   Glass.FindReferenceRanges r opts ->
-    ("FindReferenceRanges", json $ toEncoding r)
+    ("FindReferenceRanges", tid, json $ toEncoding r)
   Glass.ResolveSymbolRange r opts ->
-    ("ResolveSymbolRange", json $ toEncoding r)
+    ("ResolveSymbolRange", tid, json $ toEncoding r)
   Glass.DescribeSymbol r opts ->
-    ("DescribeSymbol", json $ toEncoding r)
+    ("DescribeSymbol", tid, json $ toEncoding r)
   Glass.SearchSymbol r opts ->
-    ("SearchSymbol", json $ toEncoding r)
+    ("SearchSymbol", tid, json $ toEncoding r)
   Glass.SearchRelated r opts req ->
-    ("SearchRelated", json $ toEncoding r)
+    ("SearchRelated", tid, json $ toEncoding r)
   Glass.SearchRelatedNeighborhood r opts req ->
-    ("SearchRelatedNeighborhood", json $ toEncoding r)
+    ("SearchRelatedNeighborhood", tid, json $ toEncoding r)
   Glass.SearchBySymbolId r opts ->
-    ("SearchBySymbolId", json $ toEncoding r)
+    ("SearchBySymbolId", tid, json $ toEncoding r)
   Glass.Index r ->
-    ("Index", json $ toEncoding r)
+    ("Index", tid, json $ toEncoding r)
   Glass.FileIncludeLocations r opts ->
-    ("FileIncludeLocations", json $ toEncoding r)
+    ("FileIncludeLocations", tid, json $ toEncoding r)
   Glass.ClangUSRToDefinition r opts ->
-    ("ClangUSRToDefinition", json $ toEncoding r)
+    ("ClangUSRToDefinition", tid, json $ toEncoding r)
 
   where
     json =

glean/glass/tools/Glean/Glass/Test/Symbol.hs

@@ -35,9 +35,10 @@ import qualified Glean.Glass.Env as Glass
 import qualified Glean.Glass.Handler as Handle
 import qualified Glean.Glass.Main as Glass
 import qualified Glean.Glass.Options as Glass
+import Glean.Glass.Tracing (GlassTrace)
 
 data Config = Config
-  { cfgGlass :: Glass.Config
+  { cfgGlass :: Glass.Config GlassTrace
   , cfgSymbol :: Maybe SymbolId
   , cfgFile :: Maybe Text
   , cfgCmd :: Cmd