diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -1,16 +1,11 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TupleSections #-} import Control.Applicative ((<|>)) -import Data.Aeson (FromJSON, FromJSONKey, eitherDecodeStrict, - parseJSON, withObject, (.:)) +import Data.Aeson (eitherDecodeStrict) import qualified Data.ByteString as BS import Data.Foldable (traverse_) import Data.List (intersect, nub, (\\)) @@ -21,9 +16,8 @@ import Data.Maybe (maybeToList) import Data.Text (Text, intercalate, map, pack) import Data.Text.IO (putStrLn) -import GHC.Generics (Generic) -import Interval (Interval, interval, intervalEnd, - intervalStart, measure, width) +import Jaeger.Data +import Jaeger.Interval import qualified Options.Applicative as Opts import Prelude hiding (map, putStrLn) @@ -43,7 +37,7 @@ data Options = Options { input :: Input - , ignoreTags :: [Tag] + , ignoreTags :: [Text] , annotated :: [ProcessID] , qualify :: Bool , wall :: Bool @@ -62,7 +56,7 @@ <> Opts.short 'f' <> Opts.metavar "FILENAME" <> Opts.help "Input file") - tag = Tag <$> Opts.strOption + tag = Opts.strOption ( Opts.short 'i' <> Opts.long "ignore" <> Opts.metavar "TAG-KEY" @@ -81,46 +75,6 @@ <> Opts.long "walltime" <> Opts.help "Takes start/end times of children into account when calculating times.") -newtype Jaeger = Jaeger [Data] -instance FromJSON Jaeger where - parseJSON = withObject "Jaeger" $ \v -> Jaeger <$> v .: "data" - -newtype TraceID = TraceID Text deriving newtype (Eq, Ord, FromJSON) -newtype SpanID = SpanID Text deriving newtype (Eq, Ord, FromJSON) -newtype ProcessID = ProcessID Text deriving newtype (Eq, Ord, FromJSON, FromJSONKey) -newtype Name = Name { unName :: Text } deriving newtype (Eq, FromJSON) - -data Data = Data - { traceID :: TraceID - , spans :: [Span] - , processes :: Map.Map ProcessID Process - } deriving (Generic, FromJSON) - -data Process = Process - { serviceName :: Text - } deriving (Generic, FromJSON) - -data Span = Span - { spanID :: SpanID - , traceID :: TraceID - , operationName :: Name - , references :: [Reference] - , startTime :: Integer - , duration :: Integer - , tags :: [Tag] - , processID :: ProcessID - } deriving (Generic, FromJSON) - -data Reference = Reference - { traceID :: TraceID - , spanID :: SpanID - } deriving (Eq, Ord, Generic, FromJSON) - -newtype Tag = Tag - { key :: Text - } deriving (Eq, Generic) - deriving anyclass (FromJSON) - type Processes = Map (TraceID, ProcessID) Process buildProcesses :: [Data] -> Processes @@ -141,7 +95,7 @@ , name :: Name , process :: ProcessID , children :: [Flame] - , tags :: [Tag] + , tags :: [Text] } selftime :: Flame -> Integer @@ -184,13 +138,13 @@ (qualifiedName operationName (traceID, processID)) processID (build <$> deps i) - tags + (key <$> tags) deps i = do refs <- maybeToList $ Map.lookup i children ref <- refs maybeToList $ lookupSpan ref - qualifiedName orig pid = case Map.lookup pid procs of - Nothing -> orig - Just p -> Name $ (unName orig) <> "..." <> (serviceName p) + qualifiedName (Name orig) pid = case Map.lookup pid procs of + Nothing -> Name orig + Just p -> Name $ orig <> "..." <> (serviceName p) -- https://github.com/brendangregg/FlameGraph/blob/master/flamegraph.pl -- @@ -217,7 +171,7 @@ , annotated :: Bool } -buildStacks :: Bool -> [Tag] -> [ProcessID] -> Flame -> [Stack] +buildStacks :: Bool -> [Text] -> [ProcessID] -> Flame -> [Stack] buildStacks wall banned annotate = stacks [] where stacks :: [Name] -> Flame -> [Stack] @@ -229,7 +183,7 @@ where t = if wall then walltime f else selftime f drawStack :: Stack -> Text -drawStack Stack{..} = intercalate ";" (map cleanup . unName <$> +drawStack Stack{..} = intercalate ";" ((\(Name n) -> map cleanup n) <$> (reverse . toList $ frames)) <> ann <> " " <> (pack . show $ samples) where cleanup ' ' = '.' diff --git a/jaeger-flamegraph.cabal b/jaeger-flamegraph.cabal --- a/jaeger-flamegraph.cabal +++ b/jaeger-flamegraph.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: jaeger-flamegraph -version: 1.2.0 +version: 1.3.0 synopsis: Generate flamegraphs from Jaeger .json dumps. license: BSD-3-Clause license-file: LICENSE @@ -11,16 +11,19 @@ tested-with: GHC ^>= 8.4.4 || ^>= 8.6.2 category: Testing description: - This is a small tool to convert JSON dumps obtained from a [Jaeger - server] (https://www.jaegertracing.io/) into a format consumable + This is a small tool to convert JSON dumps obtained from a Jaeger + server () into a format consumable by [FlameGraph](https://github.com/brendangregg/FlameGraph). . - Filter the traces for your SERVICE from the - [undocumented Jaeger API](https://github.com/jaegertracing/jaeger/issues/456). + First download the traces for your SERVICE limiting to LIMIT traces . - > $ curl http://jaeger/api/traces?service=SERVICE&limit=1000 | - > jaeger-flamegraph | - > flamegraph.pl > output.svg + > $ curl http://your-jaeger-installation/api/traces?service=SERVICE&limit=LIMIT > input.json + . + using the [undocumented Jaeger API](https://github.com/jaegertracing/jaeger/issues/456#issuecomment-412560321) + then use @jaeger-flamegraph@ to convert the data and send to @flamegraph.pl@ + . + > $ jaeger-flamegraph -f input.json | flamegraph.pl > output.svg + . source-repository head type: git @@ -32,25 +35,26 @@ build-depends: , base ^>= 4.11.1.0 || ^>= 4.12.0.0 ghc-options: -Wall -Werror=missing-home-modules + build-depends: , aeson ^>= 1.4.1.0 + , containers ^>= 0.6.0.1 + , text ^>= 1.2.3.1 default-language: Haskell2010 executable jaeger-flamegraph import: deps hs-source-dirs: exe main-is: Main.hs - build-depends: , jaeger-flamegraph-lib + build-depends: , jaeger-flamegraph , bytestring ^>= 0.10.8.2 - , containers ^>= 0.6.0.1 , extra ^>= 1.6.13 - , aeson ^>= 1.4.1.0 , optparse-applicative ^>= 0.14.3.0 - , text ^>= 1.2.3.1 ghc-options: -threaded -library jaeger-flamegraph-lib +library import: deps hs-source-dirs: library - exposed-modules: Interval + exposed-modules: Jaeger.Interval + , Jaeger.Data build-depends: , QuickCheck ^>= 2.12.6.1 test-suite tests @@ -59,7 +63,7 @@ type: exitcode-stdio-1.0 main-is: Driver.hs other-modules: IntervalTest - build-depends: , jaeger-flamegraph-lib + build-depends: , jaeger-flamegraph , tasty ^>= 1.1.0.4 , tasty-hspec ^>= 1.1.5 , tasty-quickcheck ^>= 0.10 diff --git a/library/Interval.hs b/library/Interval.hs deleted file mode 100644 --- a/library/Interval.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE NamedFieldPuns #-} - -module Interval - ( Interval - , interval - , intervalStart - , intervalEnd - , measure - , width) -where - -import Data.List (sort) -import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) - --- nothing on http://hackage.haskell.org/packages/search?terms=interval -data Interval = Interval - { intervalStart :: Integer -- ^ assume start <= end - , intervalEnd :: Integer - } deriving (Eq, Ord, Show) - -interval :: Integer -> Integer -> Interval -interval a b | a <= b = Interval a b - | otherwise = Interval b a - -width :: Interval -> Integer -width (Interval from to) = to - from - --- idea by etorreborre -measure :: [Interval] -> Integer -measure unsorted = - count $ sieve sorted - where - sorted = sort unsorted - sieve (car@(Interval a b) : cadr@(Interval c d) : rest) = - if a == c || c <= b - then sieve $ Interval a (max b d) : rest - else car : sieve (cadr : rest) - sieve done = done - count is = sum $ width <$> is - -instance Arbitrary Interval where - arbitrary = do a <- arbitrary - b <- arbitrary - pure $ interval a b diff --git a/library/Jaeger/Data.hs b/library/Jaeger/Data.hs new file mode 100644 --- /dev/null +++ b/library/Jaeger/Data.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} + +module Jaeger.Data where + +import Data.Aeson +import Data.Map.Strict (Map) +import Data.Text +import GHC.Generics (Generic) + +newtype Jaeger = Jaeger [Data] +instance FromJSON Jaeger where + parseJSON = withObject "Jaeger" $ \v -> Jaeger <$> v .: "data" +instance ToJSON Jaeger where + toJSON (Jaeger dat) = object ["data" .= dat] + +newtype TraceID = TraceID Text deriving newtype (Eq, Ord, FromJSON, ToJSON) +newtype SpanID = SpanID Text deriving newtype (Eq, Ord, FromJSON, ToJSON) +newtype ProcessID = ProcessID Text deriving newtype (Eq, Ord, FromJSON, FromJSONKey, ToJSON, ToJSONKey) +newtype Name = Name Text deriving newtype (Eq, FromJSON, ToJSON) + +data Data = Data + { traceID :: TraceID + , spans :: [Span] + , processes :: Map ProcessID Process + } deriving (Generic, FromJSON, ToJSON) + +data Process = Process + { serviceName :: Text + } deriving (Generic, FromJSON, ToJSON) + +data Span = Span + { spanID :: SpanID + , traceID :: TraceID + , operationName :: Name + , references :: [Reference] + , startTime :: Integer + , duration :: Integer + , tags :: [Tag] + , processID :: ProcessID + } deriving (Generic, FromJSON, ToJSON) + +data Reference = Reference + { traceID :: TraceID + , spanID :: SpanID + } deriving (Eq, Ord, Generic, FromJSON, ToJSON) + +data Tag = Tag + { key :: Text + , value :: Value -- arbitrary content + } deriving (Eq, Generic, FromJSON, ToJSON) diff --git a/library/Jaeger/Interval.hs b/library/Jaeger/Interval.hs new file mode 100644 --- /dev/null +++ b/library/Jaeger/Interval.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE NamedFieldPuns #-} + +module Jaeger.Interval + ( Interval + , interval + , intervalStart + , intervalEnd + , measure + , width) +where + +import Data.List (sort) +import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) + +-- nothing on http://hackage.haskell.org/packages/search?terms=interval +data Interval = Interval + { intervalStart :: Integer -- ^ assume start <= end + , intervalEnd :: Integer + } deriving (Eq, Ord, Show) + +interval :: Integer -> Integer -> Interval +interval a b | a <= b = Interval a b + | otherwise = Interval b a + +width :: Interval -> Integer +width (Interval from to) = to - from + +-- idea by etorreborre +measure :: [Interval] -> Integer +measure unsorted = + count $ sieve sorted + where + sorted = sort unsorted + sieve (car@(Interval a b) : cadr@(Interval c d) : rest) = + if a == c || c <= b + then sieve $ Interval a (max b d) : rest + else car : sieve (cadr : rest) + sieve done = done + count is = sum $ width <$> is + +instance Arbitrary Interval where + arbitrary = do a <- arbitrary + b <- arbitrary + pure $ interval a b diff --git a/test/IntervalTest.hs b/test/IntervalTest.hs --- a/test/IntervalTest.hs +++ b/test/IntervalTest.hs @@ -1,7 +1,7 @@ module IntervalTest where import Data.List (nub, permutations) -import Interval +import Jaeger.Interval import Test.Tasty.Hspec -- https://hspec.github.io/writing-specs.html