core-telemetry 0.1.7.1 → 0.1.7.2
raw patch · 2 files changed
+72/−22 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- core-telemetry.cabal +1/−1
- lib/Core/Telemetry/Honeycomb.hs +71/−21
core-telemetry.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: core-telemetry-version: 0.1.7.1+version: 0.1.7.2 synopsis: Advanced telemetry description: This is part of a library to help build command-line programs, both tools and longer-running daemons.
lib/Core/Telemetry/Honeycomb.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} {- |@@ -12,8 +13,8 @@ command-line options and environment variables to enable it: @-\$ export HONEYCOMB_TEAM="62e3626a2cc34475adef4d799eca0407"-\$ burger-service --telemetry=honeycomb --dataset=prod-restaurant-001+\$ __export HONEYCOMB_TEAM="62e3626a2cc34475adef4d799eca0407"__+\$ __burger-service --telemetry=honeycomb --dataset=prod-restaurant-001__ @ If you annotate your program with spans, you can get a trace like this:@@ -24,9 +25,9 @@ This library is Open Source but the Honeycomb service is /not/. Honeycomb offers a free tier which is quite suitable for individual use and small local-applications. You can also look at "Core.Telemetry.General" if you instead-want to forward to a generic OpenTelemetry provider. There's also-"Core.Telemetry.Console" which simply dumps telemetry to console.+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. -} module Core.Telemetry.Honeycomb ( Dataset,@@ -38,6 +39,7 @@ import Core.Program.Arguments import Core.Program.Context import Core.Program.Logging+import Core.System import Core.System.Base (stdout) import Core.System.External (TimeStamp (unTimeStamp), getCurrentTimeNanoseconds) import Core.Text.Bytes@@ -49,6 +51,7 @@ import qualified Data.ByteString.Char8 as C (append, null, putStrLn) import qualified Data.ByteString.Lazy as L (ByteString) import Data.Fixed+import Data.IORef (IORef, newIORef, readIORef, writeIORef) import qualified Data.List as List import Network.Http.Client import System.Environment (lookupEnv)@@ -144,16 +147,18 @@ undefined Value value -> pure (intoRope value) + r <- newIORef Nothing+ pure Forwarder- { telemetryHandlerFrom = process apikey dataset+ { telemetryHandlerFrom = process r apikey dataset } -- use partually applied-process :: ApiKey -> Dataset -> [Datum] -> IO ()-process apikey dataset datums = do+process :: IORef (Maybe Connection) -> ApiKey -> Dataset -> [Datum] -> IO ()+process r apikey dataset datums = do let json = JsonArray (fmap convertDatumToJson datums)- postEventToHoneycombAPI apikey dataset json+ postEventToHoneycombAPI r apikey dataset json -- implements the spec described at <https://docs.honeycomb.io/getting-data-in/tracing/send-trace-data/> convertDatumToJson :: Datum -> JsonValue@@ -201,24 +206,66 @@ ) in point -postEventToHoneycombAPI :: ApiKey -> Dataset -> JsonValue -> IO ()-postEventToHoneycombAPI apikey dataset json = do- ctx <- baselineContextSSL- c <- openConnectionSSL ctx "api.honeycomb.io" 443+acquireConnection :: IORef (Maybe Connection) -> IO Connection+acquireConnection r = do+ possible <- readIORef r+ case possible of+ Nothing -> do+ ctx <- baselineContextSSL+ c <- openConnectionSSL ctx "api.honeycomb.io" 443 - let q = buildRequest1 $ do- http POST (C.append "/1/batch/" (fromRope dataset))- setContentType "application/json"- setHeader "X-Honeycomb-Team" (fromRope (apikey))+ writeIORef r (Just c)+ pure c+ Just c -> do+ pure c - sendRequest c q (simpleBody (fromBytes (encodeToUTF8 json)))- receiveResponse c handler+cleanupConnection :: IORef (Maybe Connection) -> IO ()+cleanupConnection r = do+ finally+ ( do+ possible <- readIORef r+ case possible of+ Nothing -> pure ()+ Just c -> closeConnection c+ )+ ( do+ writeIORef r Nothing+ )++postEventToHoneycombAPI :: IORef (Maybe Connection) -> ApiKey -> Dataset -> JsonValue -> IO ()+postEventToHoneycombAPI r apikey dataset json = attempt False where+ attempt retrying = do+ catch+ ( do+ c <- acquireConnection r++ -- actually transmit telemetry to Honeycomb+ sendRequest c q (simpleBody (fromBytes (encodeToUTF8 json)))+ receiveResponse c handler+ )+ ( \(e :: SomeException) -> do+ -- ideally we don't get here, but if the SSL connection collapses+ -- we will. We retry /once/, and otherwise throw the exception out.+ cleanupConnection r+ case retrying of+ False -> do+ putStrLn "Reattempting"+ attempt True+ True -> throw e+ )++ q = buildRequest1 $ do+ http POST (C.append "/1/batch/" (fromRope dataset))+ setContentType "application/json"+ setHeader "X-Honeycomb-Team" (fromRope (apikey))+ {- Response to Batch API looks like: [{"status":202}] + TODO we need to handle other status responses properly. -} handler :: Response -> InputStream ByteString -> IO () handler p i = do@@ -232,9 +279,12 @@ where f pair = case pair of JsonObject kvs -> case lookupKeyValue "status" kvs of- Just (JsonNumber 202) -> pure ()+ Just (JsonNumber 202) -> do+ -- normal response+ pure () _ -> do- putStrLn "No status returned;"+ -- some other status!+ putStrLn "Unexpected status returned;" C.putStrLn body _ -> putStrLn "internal: wtf?" _ -> do