packages feed

core-telemetry 0.2.7.0 → 0.2.7.2

raw patch · 10 files changed

+182/−159 lines, 10 filesdep ~core-programbinary-addedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: core-program

API changes (from Hackage documentation)

Files

core-telemetry.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.35.0.+-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack  name:           core-telemetry-version:        0.2.7.0+version:        0.2.7.2 synopsis:       Advanced telemetry description:    This is part of a library to help build command-line programs, both tools and                 longer-running daemons.@@ -31,6 +31,8 @@     GHC == 8.10.7 extra-doc-files:     HoneycombTraceExample.png+    honeycomb-sad-trace.png+    honeycomb-happy-trace.png  source-repository head   type: git@@ -52,7 +54,7 @@       base >=4.11 && <5     , bytestring     , core-data >=0.3.8.0-    , core-program >=0.6.1+    , core-program >=0.6.2.2     , core-text >=0.3.7.1     , exceptions     , http-streams
+ honeycomb-happy-trace.png view

binary file changed (absent → 36119 bytes)

+ honeycomb-sad-trace.png view

binary file changed (absent → 49567 bytes)

lib/Core/Telemetry.hs view
@@ -14,28 +14,28 @@ the submodules are mostly there to group documentation, along with grouping the implementations for each of the different supported backends. -}-module Core.Telemetry (-    -- * Traces and Spans+module Core.Telemetry+    ( -- * Traces and Spans -    -- |-    -- Adding observability tracing to your program.-    module Core.Telemetry.Observability,+      -- |+      -- Adding observability tracing to your program.+        module Core.Telemetry.Observability -    -- * Exporting to backends+      -- * Exporting to backends -    -- |-    -- Processors to export telemetry to a backend.-    module Core.Telemetry.Console,-    module Core.Telemetry.General,-    module Core.Telemetry.Honeycomb,-    module Core.Telemetry.Structured,+      -- |+      -- Processors to export telemetry to a backend.+    , module Core.Telemetry.Console+    , module Core.Telemetry.General+    , module Core.Telemetry.Honeycomb+    , module Core.Telemetry.Structured -    -- * Internals+      -- * Internals -    -- |-    -- Various helper functions.-    module Core.Telemetry.Identifiers-) where+      -- |+      -- Various helper functions.+    , module Core.Telemetry.Identifiers+    ) where  import Core.Telemetry.Console import Core.Telemetry.General
lib/Core/Telemetry/Console.hs view
@@ -18,9 +18,9 @@   precise = 45.0 @ -}-module Core.Telemetry.Console (-    consoleExporter,-) where+module Core.Telemetry.Console+    ( consoleExporter+    ) where  import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TQueue (TQueue, writeTQueue)@@ -74,7 +74,7 @@                     <> singletonRope ':'                     <> let pairs :: [(JsonKey, JsonValue)]                            pairs = fromMap (attachedMetadataFrom datum)-                        in List.foldl' f emptyRope pairs+                       in  List.foldl' f emptyRope pairs                             <> intoEscapes resetColour          now <- getCurrentTimeNanoseconds@@ -90,7 +90,8 @@  f :: Rope -> (JsonKey, JsonValue) -> Rope f acc (k, v) =-    acc <> "\n  "+    acc+        <> "\n  "         <> intoEscapes pureGrey         <> intoRope k         <> " = "
lib/Core/Telemetry/General.hs view
@@ -5,9 +5,9 @@  /unimplemented/ -}-module Core.Telemetry.General (-    generalExporter,-) where+module Core.Telemetry.General+    ( generalExporter+    ) where  import Core.Program.Context
lib/Core/Telemetry/Honeycomb.hs view
@@ -29,11 +29,31 @@ applications. In the future you may be able to look at "Core.Telemetry.General" if you instead want to forward to a generic OpenTelemetry provider.++= Gotchas++Spans are sent to Honeycomb as they are closed. Hence, if you have a long+lived span, while its child spans are sent to Honeycomb and are displayed, the+parent span will be initially missing.++![Example Sad Trace](honeycomb-sad-trace.png)++This is of course jarring, because the parent is defined in the code /before/+the section where the child is called. So when writing long lived services, it+is best to call 'Core.Telemetry.Observability.beginTrace' inside a function+that will iterate continuously. That way complete telemetry will be generated+for that part of the code, making on-the-fly diagnosis and monitoring+possible.++Either way, when the parent span is closed, unless the process is killed, the+full trace will be visible.++![Example Happy Trace](honeycomb-happy-trace.png) -}-module Core.Telemetry.Honeycomb (-    Dataset,-    honeycombExporter,-) where+module Core.Telemetry.Honeycomb+    ( Dataset+    , honeycombExporter+    ) where  import Codec.Compression.GZip qualified as GZip (compress) import Control.Exception.Safe qualified as Safe (catch, finally, throw)@@ -113,7 +133,7 @@                     "The name of the dataset within your Honeycomb account that this program's telemetry will be written to."                 )                 config1-     in config2+    in  config2  setupHoneycombAction :: Context τ -> IO Forwarder setupHoneycombAction context = do@@ -211,7 +231,7 @@                     , (JsonKey "data", JsonObject meta6)                     ]                 )-     in point+    in  point  acquireConnection :: IORef (Maybe Connection) -> IO Connection acquireConnection r = do
lib/Core/Telemetry/Identifiers.hs view
@@ -15,24 +15,24 @@ identifiers into @traceparent@ headers. The key requirements are that traces be globally unique and that spans be unique within a trace. -}-module Core.Telemetry.Identifiers (-    -- * Traces and Spans-    getIdentifierTrace,-    getIdentifierSpan,-    setIdentifierSpan,+module Core.Telemetry.Identifiers+    ( -- * Traces and Spans+      getIdentifierTrace+    , getIdentifierSpan+    , setIdentifierSpan -    -- * Internals-    createIdentifierTrace,-    createIdentifierSpan,-    hostMachineIdentity,-    createTraceParentHeader,-    parseTraceParentHeader,+      -- * Internals+    , createIdentifierTrace+    , createIdentifierSpan+    , hostMachineIdentity+    , createTraceParentHeader+    , parseTraceParentHeader     -- for testing-    toHexNormal64,-    toHexReversed64,-    toHexNormal32,-    toHexReversed32,-) where+    , toHexNormal64+    , toHexReversed64+    , toHexNormal32+    , toHexReversed32+    ) where  import Control.Concurrent.MVar (modifyMVar_, readMVar) import Core.Data.Clock@@ -63,7 +63,7 @@     go [] = bogusAddress     go (interface : remainder) =         let address = mac interface-         in if address /= loopbackAddress+        in  if address /= loopbackAddress                 then address                 else go remainder @@ -88,68 +88,68 @@     let p1 = packRope (toHexReversed64 (fromIntegral (unTime time)))         p2 = packRope (toHexNormal16 rand)         p3 = packRope (convertMACToHex address)-     in Trace+    in  Trace             (p1 <> p2 <> p3)  convertMACToHex :: MAC -> [Char] convertMACToHex (MAC b1 b2 b3 b4 b5 b6) =-    nibbleToHex b1 4 :-    nibbleToHex b1 0 :-    nibbleToHex b2 4 :-    nibbleToHex b2 0 :-    nibbleToHex b3 4 :-    nibbleToHex b3 0 :-    nibbleToHex b4 4 :-    nibbleToHex b4 0 :-    nibbleToHex b5 4 :-    nibbleToHex b5 0 :-    nibbleToHex b6 4 :-    nibbleToHex b6 0 :-    []+    nibbleToHex b1 4+        : nibbleToHex b1 0+        : nibbleToHex b2 4+        : nibbleToHex b2 0+        : nibbleToHex b3 4+        : nibbleToHex b3 0+        : nibbleToHex b4 4+        : nibbleToHex b4 0+        : nibbleToHex b5 4+        : nibbleToHex b5 0+        : nibbleToHex b6 4+        : nibbleToHex b6 0+        : []   where     nibbleToHex w = unsafeToDigit . fromIntegral . (.&.) 0x0f . shiftR w  toHexReversed64 :: Word64 -> [Char] toHexReversed64 w =-    nibbleToHex 00 :-    nibbleToHex 04 :-    nibbleToHex 08 :-    nibbleToHex 12 :-    nibbleToHex 16 :-    nibbleToHex 20 :-    nibbleToHex 24 :-    nibbleToHex 28 : -- Word32-    nibbleToHex 32 :-    nibbleToHex 36 :-    nibbleToHex 40 :-    nibbleToHex 44 :-    nibbleToHex 48 :-    nibbleToHex 52 :-    nibbleToHex 56 :-    nibbleToHex 60 :-    []+    nibbleToHex 00+        : nibbleToHex 04+        : nibbleToHex 08+        : nibbleToHex 12+        : nibbleToHex 16+        : nibbleToHex 20+        : nibbleToHex 24+        : nibbleToHex 28+        : nibbleToHex 32 -- Word32+        : nibbleToHex 36+        : nibbleToHex 40+        : nibbleToHex 44+        : nibbleToHex 48+        : nibbleToHex 52+        : nibbleToHex 56+        : nibbleToHex 60+        : []   where     nibbleToHex = unsafeToDigit . fromIntegral . (.&.) 0x0f . shiftR w  toHexNormal64 :: Word64 -> [Char] toHexNormal64 w =-    nibbleToHex 60 :-    nibbleToHex 56 :-    nibbleToHex 52 :-    nibbleToHex 48 :-    nibbleToHex 44 :-    nibbleToHex 40 :-    nibbleToHex 36 :-    nibbleToHex 32 :-    nibbleToHex 28 : -- Word32-    nibbleToHex 24 :-    nibbleToHex 20 :-    nibbleToHex 16 :-    nibbleToHex 12 :-    nibbleToHex 08 :-    nibbleToHex 04 :-    nibbleToHex 00 :-    []+    nibbleToHex 60+        : nibbleToHex 56+        : nibbleToHex 52+        : nibbleToHex 48+        : nibbleToHex 44+        : nibbleToHex 40+        : nibbleToHex 36+        : nibbleToHex 32+        : nibbleToHex 28+        : nibbleToHex 24 -- Word32+        : nibbleToHex 20+        : nibbleToHex 16+        : nibbleToHex 12+        : nibbleToHex 08+        : nibbleToHex 04+        : nibbleToHex 00+        : []   where     nibbleToHex = unsafeToDigit . fromIntegral . (.&.) 0x0f . shiftR w @@ -159,39 +159,39 @@ -- toHexReversed32 :: Word32 -> [Char] toHexReversed32 w =-    nibbleToHex 00 :-    nibbleToHex 04 :-    nibbleToHex 08 :-    nibbleToHex 12 :-    nibbleToHex 16 :-    nibbleToHex 20 :-    nibbleToHex 24 :-    nibbleToHex 28 :-    []+    nibbleToHex 00+        : nibbleToHex 04+        : nibbleToHex 08+        : nibbleToHex 12+        : nibbleToHex 16+        : nibbleToHex 20+        : nibbleToHex 24+        : nibbleToHex 28+        : []   where     nibbleToHex = unsafeToDigit . fromIntegral . (.&.) 0x0f . shiftR w  toHexNormal32 :: Word32 -> [Char] toHexNormal32 w =-    nibbleToHex 28 :-    nibbleToHex 24 :-    nibbleToHex 20 :-    nibbleToHex 16 :-    nibbleToHex 12 :-    nibbleToHex 08 :-    nibbleToHex 04 :-    nibbleToHex 00 :-    []+    nibbleToHex 28+        : nibbleToHex 24+        : nibbleToHex 20+        : nibbleToHex 16+        : nibbleToHex 12+        : nibbleToHex 08+        : nibbleToHex 04+        : nibbleToHex 00+        : []   where     nibbleToHex = unsafeToDigit . fromIntegral . (.&.) 0x0f . shiftR w  toHexNormal16 :: Word16 -> [Char] toHexNormal16 w =-    nibbleToHex 12 :-    nibbleToHex 08 :-    nibbleToHex 04 :-    nibbleToHex 00 :-    []+    nibbleToHex 12+        : nibbleToHex 08+        : nibbleToHex 04+        : nibbleToHex 00+        : []   where     nibbleToHex = unsafeToDigit . fromIntegral . (.&.) 0x0f . shiftR w @@ -222,7 +222,7 @@     let t = fromIntegral (unTime time) :: Word64         r = fromIntegral rand :: Word64         w = (t .&. 0x0000ffffffffffff) .|. (shiftL r 48)-     in Span+    in  Span             ( packRope                 ( toHexReversed64 w                 )@@ -244,7 +244,7 @@ createTraceParentHeader trace unique =     let version = "00"         flags = "00"-     in version <> "-" <> unTrace trace <> "-" <> unSpan unique <> "-" <> flags+    in  version <> "-" <> unTrace trace <> "-" <> unSpan unique <> "-" <> flags  {- | Parse a @traceparent@ header into a 'Trace' and 'Span', assuming it was a@@ -258,7 +258,7 @@ parseTraceParentHeader :: Rope -> Maybe (Trace, Span) parseTraceParentHeader header =     let pieces = breakPieces (== '-') header-     in case pieces of+    in  case pieces of             ("00" : trace : unique : _ : []) -> Just (Trace trace, Span unique)             _ -> Nothing @@ -317,4 +317,4 @@         let v = currentDatumFrom context         modifyMVar_             v-            (\datum -> pure datum{spanIdentifierFrom = Just unique})+            (\datum -> pure datum {spanIdentifierFrom = Just unique})
lib/Core/Telemetry/Observability.hs view
@@ -135,35 +135,35 @@ will be gathered up and sent via the chosen exporter and forwarded to the observability or monitoring service you have chosen. -}-module Core.Telemetry.Observability (-    -- * Initializing-    Exporter,-    initializeTelemetry,+module Core.Telemetry.Observability+    ( -- * Initializing+      Exporter+    , initializeTelemetry -    -- * Traces-    Trace (..),-    Span (..),-    beginTrace,-    usingTrace,-    usingTrace',-    setServiceName,+      -- * Traces+    , Trace (..)+    , Span (..)+    , beginTrace+    , usingTrace+    , usingTrace'+    , setServiceName -    -- * Spans-    Label,-    encloseSpan,-    setStartTime,-    setSpanName,+      -- * Spans+    , Label+    , encloseSpan+    , setStartTime+    , setSpanName -    -- * Creating telemetry-    MetricValue,-    Telemetry (metric),-    telemetry,+      -- * Creating telemetry+    , MetricValue+    , Telemetry (metric)+    , telemetry -    -- * Events-    sendEvent,-    clearMetrics,-    clearTrace,-) where+      -- * Events+    , sendEvent+    , clearMetrics+    , clearTrace+    ) where  import Control.Concurrent.MVar (modifyMVar_, newMVar, readMVar) import Control.Concurrent.STM (atomically)@@ -396,7 +396,7 @@                 config0          config2 = List.foldl' f config1 exporters2-     in pure+    in  pure             ( context                 { initialConfigFrom = config2                 , initialExportersFrom = exporters2@@ -410,7 +410,7 @@     f :: Config -> Exporter -> Config     f config exporter =         let setup = setupConfigFrom exporter-         in setup config+        in  setup config  type Label = Rope @@ -757,7 +757,7 @@         let v = currentDatumFrom context         modifyMVar_             v-            (\datum -> pure datum{spanTimeFrom = time})+            (\datum -> pure datum {spanTimeFrom = time})  {- | Override the name of the current span.@@ -779,7 +779,7 @@         let v = currentDatumFrom context         modifyMVar_             v-            (\datum -> pure datum{spanNameFrom = label})+            (\datum -> pure datum {spanNameFrom = label})  {- | Reset the accumulated metadata metrics to the emtpy set.
lib/Core/Telemetry/Structured.hs view
@@ -68,9 +68,9 @@ } @ -}-module Core.Telemetry.Structured (-    structuredExporter,-) where+module Core.Telemetry.Structured+    ( structuredExporter+    ) where  import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TQueue (TQueue, writeTQueue)@@ -139,7 +139,7 @@          time = intoRope (show (spanTimeFrom datum))         meta7 = insertKeyValue "timestamp" (JsonString time) meta6-     in JsonObject meta7+    in  JsonObject meta7  processStructuredOutput :: TQueue (Maybe Rope) -> [Datum] -> IO () processStructuredOutput out datums = do