diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index d20fb55390500..6b420b721e6f8 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -110,6 +110,8 @@ library , uuid , vector , vector-builder + , binary + , base16-bytestring -- Logging related , network diff --git a/server/src-lib/Hasura/Tracing.hs b/server/src-lib/Hasura/Tracing.hs index 1e25bbae0dd89..c50fbb008b05a 100644 --- a/server/src-lib/Hasura/Tracing.hs +++ b/server/src-lib/Hasura/Tracing.hs @@ -36,6 +36,9 @@ import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Types.Header as HTTP import qualified System.Random as Rand import qualified Web.HttpApiData as HTTP +import qualified Data.Binary as Bin +import qualified Data.ByteString.Base16 as Hex + -- | Any additional human-readable key-value pairs relevant -- to the execution of a block of code. @@ -77,9 +80,9 @@ instance HasReporter m => HasReporter (ExceptT e m) where -- the active span within that trace, and the span's parent, -- unless the current span is the root. data TraceContext = TraceContext - { tcCurrentTrace :: Word64 - , tcCurrentSpan :: Word64 - , tcCurrentParent :: Maybe Word64 + { tcCurrentTrace :: !Word64 + , tcCurrentSpan :: !Word64 + , tcCurrentParent :: !(Maybe Word64) } -- | The 'TraceT' monad transformer adds the ability to keep track of @@ -198,12 +201,29 @@ instance MonadTrace m => MonadTrace (ExceptT e m) where currentReporter = lift currentReporter attachMetadata = lift . attachMetadata +-- | Encode Word64 to 16 character hex string +word64ToHex :: Word64 -> Text +word64ToHex randNum = bsToTxt $ Hex.encode numInBytes + where numInBytes = BL.toStrict (Bin.encode randNum) + +-- | Decode 16 character hex string to Word64 +-- | Hex.Decode returns two tuples: (properly decoded data, string starts at the first invalid base16 sequence) +hexToWord64 :: Text -> Maybe Word64 +hexToWord64 randText = do + let (decoded, leftovers) = Hex.decode $ txtToBs randText + decodedWord64 = Bin.decode $ BL.fromStrict decoded + guard (BS.null leftovers) + pure decodedWord64 + + -- | Inject the trace context as a set of HTTP headers. injectHttpContext :: TraceContext -> [HTTP.Header] injectHttpContext TraceContext{..} = - [ ("X-Hasura-TraceId", fromString (show tcCurrentTrace)) - , ("X-Hasura-SpanId", fromString (show tcCurrentSpan)) - ] + ("X-B3-TraceId", txtToBs $ word64ToHex tcCurrentTrace) + : ("X-B3-SpanId", txtToBs $ word64ToHex tcCurrentSpan) + : [ ("X-B3-ParentSpanId", txtToBs $ word64ToHex parentID) + | parentID <- maybeToList tcCurrentParent + ] -- | Extract the trace and parent span headers from a HTTP request -- and create a new 'TraceContext'. The new context will contain @@ -213,19 +233,20 @@ extractHttpContext :: [HTTP.Header] -> IO (Maybe TraceContext) extractHttpContext hdrs = do freshSpanId <- liftIO Rand.randomIO pure $ TraceContext - <$> (HTTP.parseHeaderMaybe =<< lookup "X-Hasura-TraceId" hdrs) + <$> (hexToWord64 =<< HTTP.parseHeaderMaybe =<< lookup "X-B3-TraceId" hdrs) <*> pure freshSpanId - <*> pure (HTTP.parseHeaderMaybe =<< lookup "X-Hasura-SpanId" hdrs) + <*> pure (hexToWord64 =<< HTTP.parseHeaderMaybe =<< lookup "X-B3-SpanId" hdrs) + -- | Inject the trace context as a JSON value, appropriate for -- storing in (e.g.) an event trigger payload. injectEventContext :: TraceContext -> J.Value -injectEventContext ctx = +injectEventContext TraceContext{..} = J.object - [ "trace_id" J..= tcCurrentTrace ctx - , "span_id" J..= tcCurrentSpan ctx + [ "trace_id" J..= tcCurrentTrace + , "span_id" J..= tcCurrentSpan ] - + -- | Extract a trace context from an event trigger payload. extractEventContext :: J.Value -> IO (Maybe TraceContext) extractEventContext e = do