datadog-tracing 1.3.2 → 1.3.3
raw patch · 4 files changed
+26/−11 lines, 4 filesdep +data-defaultdep +wai-extra
Dependencies added: data-default, wai-extra
Files
- datadog-tracing.cabal +3/−1
- exe/Main.hs +11/−4
- library/Data/MessagePack/Aeson.hs +9/−4
- library/Datadog/Jaeger.hs +3/−2
datadog-tracing.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: datadog-tracing-version: 1.3.2+version: 1.3.3 synopsis: Datadog tracing client and mock agent. license: BSD-3-Clause license-file: LICENSE@@ -69,7 +69,9 @@ hs-source-dirs: exe main-is: Main.hs build-depends: , datadog-tracing+ , data-default ^>= 0.7.1.1 , servant-server ^>= 0.14.1+ , wai-extra ^>= 3.0.25 , warp ^>= 3.2.25 ghc-options: -threaded
exe/Main.hs view
@@ -9,10 +9,13 @@ -- exposed that allows downloading all the recorded data in a format compatible -- with Jaeger tracing. -import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Class (liftIO)+import Data.Default (def) import Data.IORef-import qualified Data.Map.Strict as M-import Network.Wai.Handler.Warp (run)+import qualified Data.Map.Strict as M+import Network.Wai.Handler.Warp (run)+import Network.Wai.Middleware.RequestLogger+import Network.Wai.Middleware.RequestLogger.JSON (formatAsJSON) import Servant import Datadog.Agent@@ -23,8 +26,12 @@ main :: IO () main = do ref <- newIORef []+ logger <- mkRequestLogger $ def {+ outputFormat = CustomOutputFormatWithDetails formatAsJSON+ }+ let services = (postTraces3 ref) :<|> (postTraces4 ref) :<|> (getTraces ref)- run 8126 (serve (Proxy @ Services) services)+ run 8126 (logger $ serve (Proxy @ Services) services) postTraces3 :: IORef [Trace] -> [Trace] -> Handler NoContent postTraces3 r t = (\_ -> NoContent) <$> postTraces4 r t
library/Data/MessagePack/Aeson.hs view
@@ -2,7 +2,9 @@ -- http://hackage.haskell.org/package/msgpack-aeson-0.1.0.0/docs/src/Data-MessagePack-Aeson.html#toAeson -- with only minor changes to use the data-msgpack fork (mostly changing Vector to list). -{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} -- | Aeson bridge for MessagePack --@@ -17,12 +19,15 @@ import Data.Scientific import qualified Data.Text.Encoding as T import qualified Data.Vector as V+import Data.Word (Word64) toAeson :: MP.Object -> A.Result Value toAeson = \case ObjectNil -> pure Null ObjectBool b -> pure . Bool $ b- ObjectInt n -> pure . Number $ fromIntegral n+ ObjectInt n ->+ let w64 :: Word64 = fromIntegral n -- WARNING: silent wraparound biased to unsigned integers, fixed in next msgpack+ in pure . Number . fromIntegral $ w64 ObjectFloat f -> pure . Number $ realToFrac f ObjectDouble d -> pure . Number $ realToFrac d ObjectStr t -> pure . String $ t@@ -39,9 +44,9 @@ Null -> ObjectNil Bool b -> ObjectBool b Number s ->- case floatingOrInteger s of+ case floatingOrInteger @Double @Integer s of Left f -> ObjectDouble f- Right n -> ObjectInt n+ Right n -> ObjectInt (fromInteger n) -- WARNING: silent wraparound, fixed in next msgpack String t -> ObjectStr t Array v -> ObjectArray $ V.map fromAeson v A.Object o -> ObjectMap $ V.fromList $ map (toObject *** fromAeson) $ HM.toList o
library/Datadog/Jaeger.hs view
@@ -38,10 +38,11 @@ (M.fromList $ (\a -> (ProcessID a, Process a)) <$> services spans) spanToSpan Agent.Span{..} = let traceId = (TraceID . showt $ spanTraceId)- in Span (SpanID . showt $ spanId)+ mkSpan s = SpanID $ (showt spanTraceId) <> "-" <> (showt s)+ in Span (mkSpan spanId) traceId (Name spanName)- ((Reference traceId) . (SpanID . showt) <$> maybeToList spanParentId)+ ((Reference traceId) . mkSpan <$> maybeToList spanParentId) (toInteger spanStart) (toInteger spanDuration) (mkTag <$> (concat $ M.toList <$> spanMeta))