jaeger-flamegraph (empty) → 1.0.0
raw patch · 7 files changed
+369/−0 lines, 7 filesdep +QuickCheckdep +aesondep +basesetup-changed
Dependencies added: QuickCheck, aeson, base, bytestring, containers, extra, jaeger-flamegraph, optparse-applicative, tasty, tasty-hspec, tasty-quickcheck, text
Files
- LICENSE +26/−0
- Setup.hs +2/−0
- exe/Main.hs +198/−0
- jaeger-flamegraph.cabal +70/−0
- library/Interval.hs +40/−0
- test/Driver.hs +1/−0
- test/IntervalTest.hs +32/−0
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright 2018 Symbiont.io++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+ may be used to endorse or promote products derived from this software without+ specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ exe/Main.hs view
@@ -0,0 +1,198 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TupleSections #-}++import Control.Applicative ((<|>))+import Data.Aeson (FromJSON, eitherDecodeStrict, parseJSON,+ withObject, (.:))+import qualified Data.ByteString as BS+import Data.Foldable (traverse_)+import Data.List (intersect, nub, (\\))+import Data.List.Extra (groupSort)+import Data.List.NonEmpty (NonEmpty ((:|)), toList)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Maybe (maybeToList)+import Data.Text (Text, intercalate, map, pack)+import Data.Text.IO (putStrLn)+import GHC.Generics (Generic)+import Interval (Interval, interval, measure, width)+import qualified Options.Applicative as Opts+import Prelude hiding (map, putStrLn)++main :: IO ()+main = do+ Options{..} <- Opts.execParser $+ Opts.info (Opts.helper <*> optionsParser) Opts.fullDesc+ text <- case input of+ FileInput file -> BS.readFile file+ StdInput -> BS.getContents+ Jaeger dat <- either fail pure $ eitherDecodeStrict text+ let stacks = buildStacks ignoreTags annotated =<< (buildFlames . buildLookup $ dat)+ traverse_ (putStrLn . drawStack) stacks++data Options = Options+ { input :: Input+ , ignoreTags :: [Tag]+ , annotated :: [ProcessID]+ }+data Input = FileInput FilePath | StdInput+optionsParser :: Opts.Parser Options+optionsParser = Options+ <$> (file <|> pure StdInput)+ <*> Opts.many tag+ <*> Opts.many ann+ where+ file = FileInput <$> Opts.strOption+ ( Opts.long "file"+ <> Opts.short 'f'+ <> Opts.metavar "FILENAME"+ <> Opts.help "Input file")+ tag = Tag <$> Opts.strOption+ ( Opts.short 'i'+ <> Opts.long "ignore"+ <> Opts.metavar "TAG-KEY"+ <> Opts.help "Ignore spans with this tag key")+ ann = ProcessID <$> Opts.strOption+ ( Opts.short 'a'+ <> Opts.long "annotated"+ <> Opts.metavar "ANN"+ <> Opts.help "Annotate this process when using the `chain` palette")++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, FromJSON)+newtype Name = Name { unName :: Text } deriving newtype (Eq, FromJSON)++data Data = Data+ { traceID :: TraceID+ , spans :: [Span]+ } deriving (Generic, FromJSON)++data Span = Span+ { spanID :: SpanID+ , 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 Lookup = [(Reference, Span)]++buildLookup :: [Data] -> Lookup+buildLookup dat = do (Data t ss) <- dat+ do s @ Span{..} <- ss+ pure (Reference t spanID, s)++data Flame = Flame+ { time :: Interval+ , name :: Name+ , process :: ProcessID+ , children :: [Flame]+ , tags :: [Tag]+ }++selftime :: Flame -> Integer+selftime f = max 0 $ (width $ time f) - (measure $ time <$> children f)++-- We only support one parent per span.+--+-- https://github.com/opentracing/opentracing.io/issues/28+--+-- With multiple parents, a parent span can end at a point in time before a+-- child span. For example, in the case of doing a write which later triggers a+-- flush, the write might finish long before the flush even starts. This makes+-- it impossible to treat spans as a flame graph or traditional stack trace,+-- like you can in a single-parent world. This may make writing a GUI harder+-- since you can't do certain flame-graph-like visualizations.+buildFlames :: Lookup -> [Flame]+buildFlames ss = build <$> (maybeToList . lookupSpan =<< (nub $ roots ++ orphans))+ where+ roots :: [Reference]+ roots = fst <$> filter (\ (_, Span{..}) -> null references) ss+ orphans :: [Reference]+ orphans = do absent <- (Map.keys children) \\ (Map.keys spans)+ concat $ maybeToList $ Map.lookup absent children+ spans :: Map Reference Span+ spans = Map.fromList ss+ children :: Map Reference [Reference]+ children = Map.fromList $ groupSort $ do (i, Span{..}) <- ss+ (, i) <$> references+ lookupSpan :: Reference -> Maybe (Reference, Span)+ lookupSpan ref = (ref,) <$> (Map.lookup ref spans)+ build (i, Span{..}) = Flame (interval startTime (startTime + duration))+ operationName+ processID+ (build <$> deps i)+ tags+ deps i = do refs <- maybeToList $ Map.lookup i children+ ref <- refs+ maybeToList $ lookupSpan ref++-- https://github.com/brendangregg/FlameGraph/blob/master/flamegraph.pl+--+-- The input is stack frames and sample counts formatted as single lines. Each+-- frame in the stack is semicolon separated, with a space and count at the end+-- of the line. Example input:+--+-- swapper;start_kernel;rest_init;cpu_idle;default_idle;native_safe_halt 1+--+-- The input functions can optionally have annotations at the end of each+-- function name, following a precedent by some tools (Linux perf's _[k]):+--+-- _[k] for kernel+-- _[i] for inlined+-- _[j] for jit+-- _[w] for waker+--+-- They are used merely for colors by some palettes, eg, flamegraph.pl+-- --color=java.++data Stack = Stack+ { frames :: NonEmpty Name -- children (head) followed by parents (tail)+ , samples :: Integer+ , annotated :: Bool+ }++buildStacks :: [Tag] -> [ProcessID] -> Flame -> [Stack]+buildStacks banned annotate = stacks []+ where+ stacks :: [Name] -> Flame -> [Stack]+ stacks parents f @ Flame{..} =+ if not . null $ intersect banned tags+ then []+ else Stack (name :| parents) (selftime f) (elem process annotate) :+ (stacks (name : parents) =<< children)++drawStack :: Stack -> Text+drawStack Stack{..} = intercalate ";" (map cleanup . unName <$>+ (reverse . toList $ frames))+ <> ann <> " " <> (pack . show $ samples)+ where cleanup ' ' = '.'+ cleanup ';' = '.'+ cleanup '[' = '.'+ cleanup ']' = '.'+ cleanup c = c+ ann = pack $ if annotated then "_[w]" else ""
+ jaeger-flamegraph.cabal view
@@ -0,0 +1,70 @@+cabal-version: 2.2+name: jaeger-flamegraph+version: 1.0.0+synopsis: Generate flamegraphs from Jaeger .json dumps.+license: BSD-3-Clause+license-file: LICENSE+author: Sam Halliday+maintainer: Sam Halliday+copyright: (c) 2018 Symbiont.io+bug-reports: https://github.com/symbiont-io/jaeger-flamegraph/pulls+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+ by [FlameGraph](https://github.com/brendangregg/FlameGraph).+ .+ First download the traces for your SERVICE limiting to LIMIT traces+ .+ > $ 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+ location: https://github.com/symbiont-io/jaeger-flamegraph++-- https://www.haskell.org/cabal/users-guide/cabal-projectindex.html++common deps+ build-depends: , base ^>= 4.11.1.0 || ^>= 4.12.0.0+ ghc-options: -Wall+ -Werror=missing-home-modules+ default-language: Haskell2010++executable jaeger-flamegraph+ import: deps+ hs-source-dirs: exe+ main-is: Main.hs+ 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+ import: deps+ hs-source-dirs: library+ exposed-modules: Interval+ build-depends: , QuickCheck ^>= 2.12.6.1++test-suite tests+ import: deps+ hs-source-dirs: test+ type: exitcode-stdio-1.0+ main-is: Driver.hs+ other-modules: IntervalTest+ build-depends: , jaeger-flamegraph+ , tasty ^>= 1.1.0.4+ , tasty-hspec ^>= 1.1.5+ , tasty-quickcheck ^>= 0.10+ build-tool-depends: tasty-discover:tasty-discover ^>= 4.2.1+ ghc-options: -threaded
+ library/Interval.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE NamedFieldPuns #-}++module Interval+ ( Interval+ , interval+ , 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 Integer Integer -- ^ assume from <= to+ 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
+ test/Driver.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}
+ test/IntervalTest.hs view
@@ -0,0 +1,32 @@+module IntervalTest where++import Data.List (nub, permutations)+import Interval+import Test.Tasty.Hspec++-- https://hspec.github.io/writing-specs.html+-- https://hackage.haskell.org/package/tasty-discover++spec_interval :: Spec+spec_interval = do+ describe "measure" $ do+ it "should support one interval" $ do+ (measure [interval 10 12]) `shouldBe` 2++ it "should support disjoint intervals" $ do+ (measure [(interval 10 12), (interval 20 25)]) `shouldBe` 7++ it "should support a more complex interval" $ do+ (measure [ (interval 10 12)+ , (interval 20 25)+ , (interval 10 25)+ , (interval 21 22)+ ]) `shouldBe` 15++prop_lte :: [Interval] -> Bool+prop_lte is = (measure is) <= (sum $ width <$> is)++-- permutations is too slow, so trim the list+prop_permutations :: [Interval] -> Bool+prop_permutations is =+ 1 == (length $ nub $ measure <$> (permutations . take 7 $ is))