lightstep-haskell 0.4.2 → 0.4.3
raw patch · 3 files changed
+35/−30 lines, 3 files
Files
- examples/req/Main.hs +2/−2
- lightstep-haskell.cabal +1/−1
- src/LightStep/Propagation.hs +32/−27
examples/req/Main.hs view
@@ -3,7 +3,7 @@ import Control.Concurrent import Data.Maybe import LightStep.HighLevel.IO-import LightStep.Propagation (headersForSpanContext)+import LightStep.Propagation (b3headersForSpanContext) import Network.HTTP.Req import qualified Data.Text as T import System.Environment@@ -15,7 +15,7 @@ setTag "span.kind" "client" setTag "component" "http" Just ctx <- currentSpanContext- let opts = port 8736 <> foldMap (\(k, v) -> header k v) (headersForSpanContext ctx)+ let opts = port 8736 <> foldMap (\(k, v) -> header k v) (b3headersForSpanContext ctx) url = http "127.0.0.1" /: "test" runReq defaultHttpConfig $ req GET url NoReqBody ignoreResponse opts threadDelay 1_000_000
lightstep-haskell.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.4 name: lightstep-haskell-version: 0.4.2+version: 0.4.3 synopsis: LightStep OpenTracing client library description: LightStep OpenTracing client library. Uses GRPC transport via proto-lens. category: Tools
src/LightStep/Propagation.hs view
@@ -1,17 +1,17 @@-{-# language OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-} module LightStep.Propagation where -import Data.Bits import Control.Lens-import Data.List (foldl')+import Data.Bits import qualified Data.ByteString as BS+import Data.List (foldl') import Data.ProtoLens.Message (defMessage)+import GHC.Word import Network.HTTP.Types import Network.Wai import Proto.Collector import Proto.Collector_Fields-import GHC.Word extractSpanContextFromRequest :: Request -> Maybe SpanContext extractSpanContextFromRequest = extractSpanContextFromRequestHeaders . requestHeaders@@ -19,32 +19,38 @@ extractSpanContextFromRequestHeaders :: RequestHeaders -> Maybe SpanContext extractSpanContextFromRequestHeaders hdrs = case foldl' go (Nothing, Nothing) hdrs of- (Just tid, Just sid) -> defMessage- & traceId .~ tid- & spanId .~ sid- & Just+ (Just tid, Just sid) ->+ defMessage+ & traceId .~ tid+ & spanId .~ sid+ & Just _ -> Nothing where- -- TODO: Zipkin style propagation-- go (_, sid) ("ot-tracer-traceid", decode_u64 -> Just tid) = (Just tid, sid)- go (tid, _) ("ot-tracer-spanid", decode_u64 -> Just sid) = (tid, Just sid)-- -- TODO: Propagation of the whole span context in a single header- -- go _ ("x-ot-span-context", parse128 -> Just (tid, sid)) = (Just tid, Just sid)-- go acc _ = acc+ -- TODO: 128-bit x-b3-traceid+ go (_, sid) ("x-b3-traceid", decode_u64 -> Just tid) = (Just tid, sid)+ go (tid, _) ("x-b3-spanid", decode_u64 -> Just sid) = (tid, Just sid)+ go (_, sid) ("ot-tracer-traceid", decode_u64 -> Just tid) = (Just tid, sid)+ go (tid, _) ("ot-tracer-spanid", decode_u64 -> Just sid) = (tid, Just sid)+ -- TODO: Propagation of the whole span context in a single header+ -- go _ ("x-ot-span-context", parse128 -> Just (tid, sid)) = (Just tid, Just sid) + go acc _ = acc - -- parse128 :: BS.ByteString -> Maybe (Word64, Word64)- -- parse128 _ = Nothing -- TODO+-- parse128 :: BS.ByteString -> Maybe (Word64, Word64)+-- parse128 _ = Nothing -- TODO headersForSpanContext :: SpanContext -> [(BS.ByteString, BS.ByteString)] headersForSpanContext ctx =- [ ("ot-tracer-traceid", encode_u64 $ ctx ^. traceId)- , ("ot-tracer-spanid", encode_u64 $ ctx ^. spanId)+ [ ("ot-tracer-traceid", encode_u64 $ ctx ^. traceId),+ ("ot-tracer-spanid", encode_u64 $ ctx ^. spanId) ] +b3headersForSpanContext :: SpanContext -> [(BS.ByteString, BS.ByteString)]+b3headersForSpanContext ctx =+ [ ("x-b3-traceid", encode_u64 $ ctx ^. traceId),+ ("x-b3-spanid", encode_u64 $ ctx ^. spanId)+ ]+ encode_u64 :: Word64 -> BS.ByteString -- TODO: a better way to encode base16 encode_u64 x =@@ -55,14 +61,13 @@ go :: Int -> [Word8] -> Word64 -> [Word8] go 0 acc _ = acc go n acc v = go (n - 1) (encodeChar (fromIntegral v .&. 0x0f) : acc) (v `div` 16)- in BS.pack hexDigits+ in BS.pack hexDigits decode_u64 :: BS.ByteString -> Maybe Word64 decode_u64 bytes | BS.length bytes /= 16 = Nothing decode_u64 bytes = BS.foldl' go (Just 0) bytes where- go Nothing _ = Nothing- go (Just !result) d | d >= 48 && d < 58 = Just $ result * 16 + fromIntegral d - 48- go (Just result) d | d >= 97 && d < 124 = Just $ result * 16 + fromIntegral d - 87- go _ _ = Nothing-+ go Nothing _ = Nothing+ go (Just !result) d | d >= 48 && d < 58 = Just $ result * 16 + fromIntegral d - 48+ go (Just result) d | d >= 97 && d < 124 = Just $ result * 16 + fromIntegral d - 87+ go _ _ = Nothing