tracing 0.0.7.1 → 0.0.7.2

raw patch · 3 files changed

+35/−8 lines, 3 files

Files

• src/Monitor/Tracing/Zipkin.hs +28/−7
• test/Spec.hs +6/−0
• tracing.cabal +1/−1

@@ -175,12 +175,13 @@ addTag key val bldr =   bldr { builderTags = Map.insert (publicKeyPrefix <> key) (JSON.toJSON val) (builderTags bldr) } --- | Adds a producer kind tag to a builder. This is a convenience method to use with 'rootSpanWith', for example:+-- | Adds a producer kind tag to a builder. This is a convenience method to use with 'rootSpanWith',+-- for example: -- -- > rootSpanWith addProducerKind alwaysSampled "root" $ action ----- Use this method if you want to create a root producer span.--- Otherwise use 'producerSpanWith' to create a sub span with producer kind.+-- Use this method if you want to create a root producer span. Otherwise use 'producerSpanWith' to+-- create a sub span with producer kind. addProducerKind :: Builder -> Builder addProducerKind = addTag kindKey producerKindValue @@ -231,7 +232,7 @@ b3ToHeaders :: B3 -> Map (CI ByteString) ByteString b3ToHeaders (B3 traceID spanID isSampled isDebug mbParentID) =   let-    defaultKVs = [(traceIDHeader, encodeTraceID traceID), (spanIDHeader, encodeSpanID spanID)]+    defaultKVs = [(traceIDHeader, encodeZipkinTraceID traceID), (spanIDHeader, encodeSpanID spanID)]     parentKVs = (parentSpanIDHeader,) . encodeSpanID <$> maybeToList mbParentID     sampledKVs = case (isSampled, isDebug) of       (_, True) -> [(debugHeader, "1")]@@ -253,7 +254,7 @@   sampled <- findBool dbg sampledHeader   guard (not $ sampled == False && dbg)   B3-    <$> (find traceIDHeader >>= decodeTraceID)+    <$> (find traceIDHeader >>= decodeZipkinTraceID)     <*> (find spanIDHeader >>= decodeSpanID)     <*> pure sampled     <*> pure dbg@@ -268,15 +269,35 @@       (_ , True) -> "d"       (True, _) -> "1"       (False, _) -> "0"-    required = [encodeTraceID traceID, encodeSpanID spanID, state]+    required = [encodeZipkinTraceID traceID, encodeSpanID spanID, state]     optional = encodeSpanID <$> maybeToList mbParentID   in BS.intercalate "-" $ fmap T.encodeUtf8 $ required ++ optional +-- | Prefix used to fill up 128-bit if only a 64-bit trace identifier is given.+shortTraceIDPrefix :: Text+shortTraceIDPrefix = "0000000000000000"++-- | Decodes a zipkin trace ID from a hex-encoded string, returning nothing if it is invalid. Takes+-- into account that the provided string could be a 16 or 32 lower-hex character trace ID. If the+-- given string consists of 16 lower-hex characters 'shortTraceIDPrefix' is used to fil up the+-- 128-bit trace identifier of 'TraceID'.+decodeZipkinTraceID :: Text -> Maybe TraceID+decodeZipkinTraceID txt =+  let normalized = if T.length txt == 16 then shortTraceIDPrefix <> txt else txt+  in decodeTraceID normalized++-- | Hex-encodes a trace ID, providing a 16 or 32 lower-hex character zipkin trace ID. A 16+-- lower-hex character string is returned if the first 64-bits of the 'TraceID' are zeros.+encodeZipkinTraceID :: TraceID -> Text+encodeZipkinTraceID traceID =+  let txt = encodeTraceID traceID+  in fromMaybe txt $ T.stripPrefix shortTraceIDPrefix txt+ -- | Deserializes a single header value into a 'B3'. b3FromHeaderValue :: ByteString -> Maybe B3 b3FromHeaderValue bs = case T.splitOn "-" $ T.decodeUtf8 bs of   (traceIDstr:spanIDstr:strs) -> do-    traceID <- decodeTraceID traceIDstr+    traceID <- decodeZipkinTraceID traceIDstr     spanID <- decodeSpanID spanIDstr     let buildB3 = B3 traceID spanID     case strs of

@@ -71,6 +71,12 @@         mbBs = ZPK.b3ToHeaderValue <$> ZPK.b3FromHeaderValue bs       mbBs `shouldBe` Just bs +    it "should round-trip a B3 using a single header with a 16 lower-hex character TraceId" $ do+      let+        bs = "64fe8b2a57d3eff7-e457b5a2e4d86bd1-1-05e3ac9a4f6e3b90"+        mbBs = ZPK.b3ToHeaderValue <$> ZPK.b3FromHeaderValue bs+      mbBs `shouldBe` Just bs+     it "should have equivalent B3 header representations" $ do       let         bs = "80f198ee56343ba864fe8b2a57d3eff7-e457b5a2e4d86bd1-1-05e3ac9a4f6e3b90"

@@ -1,7 +1,7 @@ cabal-version: 2.0  name: tracing-version: 0.0.7.1+version: 0.0.7.2 synopsis: Distributed tracing description:   An OpenTracing-compliant, simple, and extensible distributed tracing library.