{-# LANGUAGE GADTs #-}
module Reporter.Honeycomb.Internal where
import qualified Control.Exception.Safe as Exception
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as ByteString
import qualified Data.List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text.Encoding as Encoding
import qualified Data.Text.IO
import qualified Data.UUID
import qualified Data.UUID.V4
import qualified Data.Word
import qualified Dict
import qualified Environment
import qualified GHC.Stack as Stack
import qualified List
import qualified Log
import qualified Log.HttpRequest as HttpRequest
import qualified Log.Kafka as Kafka
import qualified Log.RedisCommands as RedisCommands
import qualified Log.SqlQuery as SqlQuery
import qualified Maybe
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.TLS as HTTP.TLS
import qualified Network.HostName
import qualified Platform
import qualified Platform.AesonHelpers as AesonHelpers
import qualified Platform.Timer as Timer
import qualified System.Random as Random
import qualified Text
import qualified Text as NriText
import qualified Prelude
batchApiEndpoint :: Text -> Text
batchApiEndpoint :: Text -> Text
batchApiEndpoint Text
datasetName = Text
"https://api.honeycomb.io/1/batch/" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
datasetName
report :: Handler -> Text -> Platform.TracingSpan -> Prelude.IO ()
report :: Handler -> Text -> TracingSpan -> IO ()
report Handler
handler' Text
_requestId TracingSpan
span = do
SendOrSample
sendOrSample <- Handler -> TracingSpan -> IO SendOrSample
makeSharedTraceData Handler
handler' TracingSpan
span
case SendOrSample
sendOrSample of
SendOrSample
SampledOut -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ()
SendToHoneycomb SharedTraceData
sharedTraceData -> Handler -> SharedTraceData -> TracingSpan -> IO ()
sendToHoneycomb Handler
handler' SharedTraceData
sharedTraceData TracingSpan
span
sendToHoneycomb :: Handler -> SharedTraceData -> Platform.TracingSpan -> Prelude.IO ()
sendToHoneycomb :: Handler -> SharedTraceData -> TracingSpan -> IO ()
sendToHoneycomb Handler
handler' SharedTraceData
sharedTraceData TracingSpan
span = do
let events :: List BatchEvent
events = SharedTraceData -> TracingSpan -> List BatchEvent
toBatchEvents SharedTraceData
sharedTraceData TracingSpan
span
Request
baseRequest <-
Handler -> Settings
settings Handler
handler'
Settings -> (Settings -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Settings -> Text
datasetName
Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> Text
batchApiEndpoint
Text -> (Text -> List Char) -> List Char
forall a b. a -> (a -> b) -> b
|> Text -> List Char
Text.toList
List Char -> (List Char -> IO Request) -> IO Request
forall a b. a -> (a -> b) -> b
|> List Char -> IO Request
forall (m :: * -> *). MonadThrow m => List Char -> m Request
HTTP.parseRequest
let req :: Request
req =
Request
baseRequest
{ method :: Method
HTTP.method = Method
"POST",
requestHeaders :: RequestHeaders
HTTP.requestHeaders =
[ ( HeaderName
"X-Honeycomb-Team",
Handler -> Settings
settings Handler
handler'
Settings -> (Settings -> Secret Method) -> Secret Method
forall a b. a -> (a -> b) -> b
|> Settings -> Secret Method
apiKey
Secret Method -> (Secret Method -> Method) -> Method
forall a b. a -> (a -> b) -> b
|> Secret Method -> Method
forall a. Secret a -> a
Log.unSecret
)
],
requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS (List BatchEvent -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode List BatchEvent
events)
}
Response ()
_ <- Request -> Manager -> IO (Response ())
HTTP.httpNoBody Request
req (Handler -> Manager
http Handler
handler')
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ()
getRootSpanRequestPath :: Platform.TracingSpan -> Maybe Text
getRootSpanRequestPath :: TracingSpan -> Maybe Text
getRootSpanRequestPath TracingSpan
rootSpan =
TracingSpan -> Maybe SomeTracingSpanDetails
Platform.details TracingSpan
rootSpan
Maybe SomeTracingSpanDetails
-> (Maybe SomeTracingSpanDetails -> Maybe (Maybe Text))
-> Maybe (Maybe Text)
forall a b. a -> (a -> b) -> b
|> (SomeTracingSpanDetails -> Maybe (Maybe Text))
-> Maybe SomeTracingSpanDetails -> Maybe (Maybe Text)
forall a b. (a -> Maybe b) -> Maybe a -> Maybe b
Maybe.andThen
( [Renderer (Maybe Text)]
-> SomeTracingSpanDetails -> Maybe (Maybe Text)
forall a. [Renderer a] -> SomeTracingSpanDetails -> Maybe a
Platform.renderTracingSpanDetails
[ (Incoming -> Maybe Text) -> Renderer (Maybe Text)
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer (\(HttpRequest.Incoming Details
details) -> Details -> Maybe Text
HttpRequest.endpoint Details
details)
]
)
Maybe (Maybe Text)
-> (Maybe (Maybe Text) -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
|> (Maybe Text -> Maybe Text) -> Maybe (Maybe Text) -> Maybe Text
forall a b. (a -> Maybe b) -> Maybe a -> Maybe b
Maybe.andThen Maybe Text -> Maybe Text
forall a. a -> a
identity
getSpanEndpoint :: Platform.TracingSpan -> Maybe Text
getSpanEndpoint :: TracingSpan -> Maybe Text
getSpanEndpoint TracingSpan
span =
TracingSpan
span
TracingSpan
-> (TracingSpan -> Maybe SomeTracingSpanDetails)
-> Maybe SomeTracingSpanDetails
forall a b. a -> (a -> b) -> b
|> TracingSpan -> Maybe SomeTracingSpanDetails
Platform.details
Maybe SomeTracingSpanDetails
-> (Maybe SomeTracingSpanDetails -> Maybe (Maybe Text))
-> Maybe (Maybe Text)
forall a b. a -> (a -> b) -> b
|> (SomeTracingSpanDetails -> Maybe (Maybe Text))
-> Maybe SomeTracingSpanDetails -> Maybe (Maybe Text)
forall a b. (a -> Maybe b) -> Maybe a -> Maybe b
Maybe.andThen
( [Renderer (Maybe Text)]
-> SomeTracingSpanDetails -> Maybe (Maybe Text)
forall a. [Renderer a] -> SomeTracingSpanDetails -> Maybe a
Platform.renderTracingSpanDetails
[ (Incoming -> Maybe Text) -> Renderer (Maybe Text)
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer (\(HttpRequest.Incoming Details
details) -> Details -> Maybe Text
HttpRequest.endpoint Details
details),
(Details -> Maybe Text) -> Renderer (Maybe Text)
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer Details -> Maybe Text
Kafka.topic
]
)
Maybe (Maybe Text)
-> (Maybe (Maybe Text) -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
|> (Maybe Text -> Maybe Text) -> Maybe (Maybe Text) -> Maybe Text
forall a b. (a -> Maybe b) -> Maybe a -> Maybe b
Maybe.andThen Maybe Text -> Maybe Text
forall a. a -> a
identity
deriveSampleRate :: Platform.TracingSpan -> Settings -> Float
deriveSampleRate :: TracingSpan -> Settings -> Float
deriveSampleRate TracingSpan
rootSpan Settings
settings =
let isNonAppRequestPath :: Bool
isNonAppRequestPath =
case TracingSpan -> Maybe Text
getRootSpanRequestPath TracingSpan
rootSpan of
Maybe Text
Nothing -> Bool
False
Just Text
requestPath -> (Text -> Bool) -> List Text -> Bool
forall a. (a -> Bool) -> List a -> Bool
List.any (Text
requestPath Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) [Text
"/health/readiness", Text
"/metrics", Text
"/health/liveness"]
baseRate :: Float
baseRate = Settings -> Float -> TracingSpan -> Float
modifyFractionOfSuccessRequestsLogged Settings
settings (Settings -> Float
fractionOfSuccessRequestsLogged Settings
settings) TracingSpan
rootSpan
requestDurationMs :: Float
requestDurationMs =
MonotonicTime -> MonotonicTime -> MonotonicTime
Timer.difference (TracingSpan -> MonotonicTime
Platform.started TracingSpan
rootSpan) (TracingSpan -> MonotonicTime
Platform.finished TracingSpan
rootSpan)
MonotonicTime -> (MonotonicTime -> Word64) -> Word64
forall a b. a -> (a -> b) -> b
|> MonotonicTime -> Word64
Platform.inMicroseconds
Word64 -> (Word64 -> Float) -> Float
forall a b. a -> (a -> b) -> b
|> Word64 -> Float
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
Float -> (Float -> Float) -> Float
forall a b. a -> (a -> b) -> b
|> Float -> Float -> Float
forall number. Num number => number -> number -> number
(*) Float
1e-3
apdexTMs :: Float
apdexTMs =
Settings -> Int -> TracingSpan -> Int
modifyApdexTimeMs Settings
settings (Settings -> Int
apdexTimeMs Settings
settings) TracingSpan
rootSpan
Int -> (Int -> Float) -> Float
forall a b. a -> (a -> b) -> b
|> Int -> Float
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
in if Bool
isNonAppRequestPath
then
Float
baseRate Float -> Float -> Float
/ Float
500
else Float -> Float -> Float -> Float
sampleRateForDuration Float
baseRate Float
requestDurationMs Float
apdexTMs
sampleRateForDuration :: Float -> Float -> Float -> Float
sampleRateForDuration :: Float -> Float -> Float -> Float
sampleRateForDuration Float
baseRate Float
requestDurationMs Float
apdexTMs =
Float
baseRate Float -> Float -> Float
forall number. Num number => number -> number -> number
* (Float
1.5 Float -> Float -> Float
^ (Float
requestDurationMs Float -> Float -> Float
/ Float
apdexTMs))
Float -> (Float -> Float) -> Float
forall a b. a -> (a -> b) -> b
|> Float -> Float -> Float -> Float
forall number. Ord number => number -> number -> number -> number
clamp Float
baseRate Float
1
calculateApdex :: Settings -> Platform.TracingSpan -> Float
calculateApdex :: Settings -> TracingSpan -> Float
calculateApdex Settings
settings TracingSpan
span =
case TracingSpan -> Succeeded
Platform.succeeded TracingSpan
span of
Succeeded
Platform.Failed -> Float
0
Platform.FailedWith SomeException
_ -> Float
0
Succeeded
Platform.Succeeded ->
let duration :: Int
duration =
TracingSpan -> MonotonicTime
spanDuration TracingSpan
span
MonotonicTime -> (MonotonicTime -> Word64) -> Word64
forall a b. a -> (a -> b) -> b
|> MonotonicTime -> Word64
Platform.inMicroseconds
Word64 -> (Word64 -> Int) -> Int
forall a b. a -> (a -> b) -> b
|> Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
apdexTUs :: Int
apdexTUs = Int
1000 Int -> Int -> Int
forall number. Num number => number -> number -> number
* Settings -> Int
apdexTimeMs Settings
settings
in if Int
duration Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
< Int
apdexTUs
then Float
1
else
if Int
duration Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
< (Int
4 Int -> Int -> Int
forall number. Num number => number -> number -> number
* Int
apdexTUs)
then Float
0.5
else Float
0
toBatchEvents :: SharedTraceData -> Platform.TracingSpan -> List BatchEvent
toBatchEvents :: SharedTraceData -> TracingSpan -> List BatchEvent
toBatchEvents SharedTraceData
sharedTraceData TracingSpan
span =
let ((StatsByName, Int)
_, List BatchEvent
events) =
SharedTraceData
-> Maybe SpanId
-> (StatsByName, Int)
-> TracingSpan
-> ((StatsByName, Int), List BatchEvent)
batchEventsHelper
SharedTraceData
sharedTraceData
Maybe SpanId
forall a. Maybe a
Nothing
(StatsByName
emptyStatsByName, Int
0)
TracingSpan
span
in List BatchEvent
events
batchEventsHelper ::
SharedTraceData ->
Maybe SpanId ->
(StatsByName, Int) ->
Platform.TracingSpan ->
((StatsByName, Int), [BatchEvent])
batchEventsHelper :: SharedTraceData
-> Maybe SpanId
-> (StatsByName, Int)
-> TracingSpan
-> ((StatsByName, Int), List BatchEvent)
batchEventsHelper SharedTraceData
sharedTraceData Maybe SpanId
parentSpanId (StatsByName
statsByName, Int
spanIndex) TracingSpan
span = do
let isRootSpan :: Bool
isRootSpan = Maybe SpanId
parentSpanId Maybe SpanId -> Maybe SpanId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe SpanId
forall a. Maybe a
Nothing
let thisSpansId :: SpanId
thisSpansId = Text -> SpanId
SpanId (SharedTraceData -> Text
requestId SharedTraceData
sharedTraceData Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"-" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
NriText.fromInt Int
spanIndex)
let ((StatsByName
lastStatsByName, Int
lastSpanIndex), [List BatchEvent]
nestedChildren) =
((StatsByName, Int)
-> TracingSpan -> ((StatsByName, Int), List BatchEvent))
-> (StatsByName, Int)
-> [TracingSpan]
-> ((StatsByName, Int), [List BatchEvent])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
Data.List.mapAccumL
(SharedTraceData
-> Maybe SpanId
-> (StatsByName, Int)
-> TracingSpan
-> ((StatsByName, Int), List BatchEvent)
batchEventsHelper SharedTraceData
sharedTraceData (SpanId -> Maybe SpanId
forall a. a -> Maybe a
Just SpanId
thisSpansId))
(
if Bool
isRootSpan
then StatsByName
statsByName
else TracingSpan -> StatsByName -> StatsByName
recordStats TracingSpan
span StatsByName
statsByName,
Int
spanIndex Int -> Int -> Int
forall number. Num number => number -> number -> number
+ Int
1
)
(TracingSpan -> [TracingSpan]
Platform.children TracingSpan
span)
let children :: List BatchEvent
children = [List BatchEvent] -> List BatchEvent
forall a. List (List a) -> List a
List.concat [List BatchEvent]
nestedChildren
let duration :: Word64
duration =
MonotonicTime -> MonotonicTime -> MonotonicTime
Timer.difference (TracingSpan -> MonotonicTime
Platform.started TracingSpan
span) (TracingSpan -> MonotonicTime
Platform.finished TracingSpan
span)
MonotonicTime -> (MonotonicTime -> Word64) -> Word64
forall a b. a -> (a -> b) -> b
|> MonotonicTime -> Word64
Platform.inMicroseconds
let timestamp :: Text
timestamp = Timer -> MonotonicTime -> Text
Timer.toISO8601 (SharedTraceData -> Timer
timer SharedTraceData
sharedTraceData) (TracingSpan -> MonotonicTime
Platform.started TracingSpan
span)
let sourceLocation :: Maybe Text
sourceLocation =
TracingSpan -> Maybe (Text, SrcLoc)
Platform.frame TracingSpan
span
Maybe (Text, SrcLoc)
-> (Maybe (Text, SrcLoc) -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
|> ((Text, SrcLoc) -> Text) -> Maybe (Text, SrcLoc) -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
Maybe.map
( \(Text
_, SrcLoc
frame) ->
List Char -> Text
Text.fromList (SrcLoc -> List Char
Stack.srcLocFile SrcLoc
frame)
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
":"
Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt (Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
frame))
)
let isError :: Bool
isError = case TracingSpan -> Succeeded
Platform.succeeded TracingSpan
span of
Succeeded
Platform.Succeeded -> Bool
False
Succeeded
Platform.Failed -> Bool
True
Platform.FailedWith SomeException
_ -> Bool
True
let addStats :: Span -> Span
addStats Span
span' =
if Bool
isRootSpan
then StatsByName -> Span -> Span
perSpanNameStats StatsByName
lastStatsByName Span
span'
else Span
span'
let addEndpoint :: Span -> Span
addEndpoint Span
span' =
case SharedTraceData -> Maybe Text
endpoint SharedTraceData
sharedTraceData of
Maybe Text
Nothing -> Span
span'
Just Text
endpoint -> Text -> Text -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"endpoint" Text
endpoint Span
span'
let hcSpan :: Span
hcSpan =
SharedTraceData -> Span
initSpan SharedTraceData
sharedTraceData
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Text -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"name" (TracingSpan -> Text
Platform.name TracingSpan
span)
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> SpanId -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"trace.span_id" SpanId
thisSpansId
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Maybe SpanId -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"trace.parent_id" Maybe SpanId
parentSpanId
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Float -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"duration_ms" (Word64 -> Float
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Word64
duration Float -> Float -> Float
/ Float
1000)
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Int -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"allocated_bytes" (TracingSpan -> Int
Platform.allocated TracingSpan
span)
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Bool -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"failed" Bool
isError
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Maybe Text -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"source_location" Maybe Text
sourceLocation
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> TracingSpan -> Span -> Span
addDetails TracingSpan
span
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Span -> Span
addEndpoint
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Span -> Span
addStats
( (StatsByName
lastStatsByName, Int
lastSpanIndex),
BatchEvent :: Text -> Span -> Int -> BatchEvent
BatchEvent
{ batchevent_time :: Text
batchevent_time = Text
timestamp,
batchevent_data :: Span
batchevent_data = Span
hcSpan,
batchevent_samplerate :: Int
batchevent_samplerate = SharedTraceData -> Int
sampleRate SharedTraceData
sharedTraceData
} BatchEvent -> List BatchEvent -> List BatchEvent
forall a. a -> [a] -> [a]
:
List BatchEvent
children
)
data Stats = Stats
{ Stats -> Int
count :: Int,
Stats -> Word64
totalTimeMicroseconds :: Data.Word.Word64
}
newtype StatsByName = StatsByName (Dict.Dict Text Stats)
emptyStatsByName :: StatsByName
emptyStatsByName :: StatsByName
emptyStatsByName = Dict Text Stats -> StatsByName
StatsByName Dict Text Stats
forall k v. Dict k v
Dict.empty
recordStats :: Platform.TracingSpan -> StatsByName -> StatsByName
recordStats :: TracingSpan -> StatsByName -> StatsByName
recordStats TracingSpan
span (StatsByName Dict Text Stats
statsByName) =
let name :: Text
name = TracingSpan -> Text
Platform.name TracingSpan
span
duration :: Word64
duration = MonotonicTime -> Word64
Platform.inMicroseconds (TracingSpan -> MonotonicTime
spanDuration TracingSpan
span)
newStats :: Stats
newStats =
case Text -> Dict Text Stats -> Maybe Stats
forall comparable v.
Ord comparable =>
comparable -> Dict comparable v -> Maybe v
Dict.get Text
name Dict Text Stats
statsByName of
Maybe Stats
Nothing ->
Stats :: Int -> Word64 -> Stats
Stats
{ count :: Int
count = Int
1,
totalTimeMicroseconds :: Word64
totalTimeMicroseconds = Word64
duration
}
Just Stats
stats ->
Stats :: Int -> Word64 -> Stats
Stats
{ count :: Int
count = Int
1 Int -> Int -> Int
forall number. Num number => number -> number -> number
+ Stats -> Int
count Stats
stats,
totalTimeMicroseconds :: Word64
totalTimeMicroseconds = Word64
duration Word64 -> Word64 -> Word64
forall number. Num number => number -> number -> number
+ Stats -> Word64
totalTimeMicroseconds Stats
stats
}
in Dict Text Stats -> StatsByName
StatsByName (Text -> Stats -> Dict Text Stats -> Dict Text Stats
forall comparable v.
Ord comparable =>
comparable -> v -> Dict comparable v -> Dict comparable v
Dict.insert Text
name Stats
newStats Dict Text Stats
statsByName)
spanDuration :: Platform.TracingSpan -> Platform.MonotonicTime
spanDuration :: TracingSpan -> MonotonicTime
spanDuration TracingSpan
span =
MonotonicTime -> MonotonicTime -> MonotonicTime
Timer.difference (TracingSpan -> MonotonicTime
Platform.started TracingSpan
span) (TracingSpan -> MonotonicTime
Platform.finished TracingSpan
span)
perSpanNameStats :: StatsByName -> Span -> Span
perSpanNameStats :: StatsByName -> Span -> Span
perSpanNameStats (StatsByName Dict Text Stats
statsByName) Span
span =
let
statsForCategory :: (Text, Stats) -> Span -> Span
statsForCategory (Text
name, Stats
stats) Span
acc =
let calls :: Int
calls = Stats -> Int
count Stats
stats
total :: Float
total = Word64 -> Float
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Stats -> Word64
totalTimeMicroseconds Stats
stats) Float -> Float -> Float
/ Float
1000
average :: Float
average = Float
total Float -> Float -> Float
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int
calls
saneName :: Text
saneName = Text -> Text
useAsKey Text
name
in Span
acc
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Float -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField (Text
"stats.total_time_ms." Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
saneName) Float
total
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Float -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField (Text
"stats.average_time_ms." Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
saneName) Float
average
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Int -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField (Text
"stats.count." Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
saneName) Int
calls
in ((Text, Stats) -> Span -> Span)
-> Span -> List (Text, Stats) -> Span
forall a b. (a -> b -> b) -> b -> List a -> b
List.foldl (Text, Stats) -> Span -> Span
statsForCategory Span
span (Dict Text Stats -> List (Text, Stats)
forall k v. Dict k v -> List (k, v)
Dict.toList Dict Text Stats
statsByName)
useAsKey :: Text -> Text
useAsKey :: Text -> Text
useAsKey Text
str =
Text
str
Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> Text
NriText.toLower
Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> Text -> Text -> Text
NriText.replace Text
" " Text
"_"
addDetails :: Platform.TracingSpan -> Span -> Span
addDetails :: TracingSpan -> Span -> Span
addDetails TracingSpan
tracingSpan Span
honeycombSpan =
case TracingSpan -> Maybe SomeTracingSpanDetails
Platform.details TracingSpan
tracingSpan of
Just SomeTracingSpanDetails
details ->
SomeTracingSpanDetails
details
SomeTracingSpanDetails
-> (SomeTracingSpanDetails -> Maybe Span) -> Maybe Span
forall a b. a -> (a -> b) -> b
|> [Renderer Span] -> SomeTracingSpanDetails -> Maybe Span
forall a. [Renderer a] -> SomeTracingSpanDetails -> Maybe a
Platform.renderTracingSpanDetails
[ (LogContexts -> Span) -> Renderer Span
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer (Span -> LogContexts -> Span
renderDetailsLog Span
honeycombSpan),
(Details -> Span) -> Renderer Span
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer (Span -> Details -> Span
renderDetailsRedis Span
honeycombSpan),
(Incoming -> Span) -> Renderer Span
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer
( \(Incoming
_ :: HttpRequest.Incoming) ->
Text -> SomeTracingSpanDetails -> Span -> Span
renderDetailsGeneric Text
"http" SomeTracingSpanDetails
details Span
honeycombSpan
),
(Details -> Span) -> Renderer Span
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer
( \(Details
_ :: SqlQuery.Details) ->
Text -> SomeTracingSpanDetails -> Span -> Span
renderDetailsGeneric Text
"sql" SomeTracingSpanDetails
details Span
honeycombSpan
),
(Details -> Span) -> Renderer Span
forall s a. TracingSpanDetails s => (s -> a) -> Renderer a
Platform.Renderer
( \(Details
_ :: Kafka.Details) ->
Text -> SomeTracingSpanDetails -> Span -> Span
renderDetailsGeneric Text
"kafka" SomeTracingSpanDetails
details Span
honeycombSpan
)
]
Maybe Span -> (Maybe Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Span -> Maybe Span -> Span
forall a. a -> Maybe a -> a
Maybe.withDefault
(Text -> SomeTracingSpanDetails -> Span -> Span
renderDetailsGeneric (TracingSpan -> Text
Platform.name TracingSpan
tracingSpan) SomeTracingSpanDetails
details Span
honeycombSpan)
Maybe SomeTracingSpanDetails
Nothing -> Span
honeycombSpan
renderDetailsGeneric :: Text -> Platform.SomeTracingSpanDetails -> Span -> Span
renderDetailsGeneric :: Text -> SomeTracingSpanDetails -> Span -> Span
renderDetailsGeneric Text
keyPrefix SomeTracingSpanDetails
details Span
honeycombSpan =
case SomeTracingSpanDetails -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON SomeTracingSpanDetails
details of
Aeson.Object Object
object ->
(Text -> Value -> Span -> Span) -> Span -> Object -> Span
forall acc. (Text -> Value -> acc -> acc) -> acc -> Object -> acc
AesonHelpers.foldObject
(\Text
key Value
value -> Text -> Value -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField (Text -> Text
useAsKey (Text
keyPrefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"." Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key)) Value
value)
Span
honeycombSpan
Object
object
Value
jsonVal -> Text -> Value -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
keyPrefix Value
jsonVal Span
honeycombSpan
renderDetailsLog :: Span -> Log.LogContexts -> Span
renderDetailsLog :: Span -> LogContexts -> Span
renderDetailsLog Span
span context :: LogContexts
context@(Log.LogContexts [Context]
contexts) =
if [Context] -> Int
forall a. List a -> Int
List.length [Context]
contexts Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
> Int
5
then Text -> LogContexts -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"log.context" LogContexts
context Span
span
else
(Context -> Span -> Span) -> Span -> [Context] -> Span
forall a b. (a -> b -> b) -> b -> List a -> b
List.foldl
(\(Log.Context Text
key a
val) -> Text -> a -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField (Text
"log." Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) a
val)
Span
span
[Context]
contexts
renderDetailsRedis :: Span -> RedisCommands.Details -> Span
renderDetailsRedis :: Span -> Details -> Span
renderDetailsRedis Span
span Details
redisInfo =
let addCommandCounts :: Span -> Span
addCommandCounts Span
span' =
Details
redisInfo
Details -> (Details -> List Text) -> List Text
forall a b. a -> (a -> b) -> b
|> Details -> List Text
RedisCommands.commands
List Text -> (List Text -> List Text) -> List Text
forall a b. a -> (a -> b) -> b
|> (Text -> Maybe Text) -> List Text -> List Text
forall a b. (a -> Maybe b) -> List a -> List b
List.filterMap (Text -> List Text
NriText.words (Text -> List Text)
-> (List Text -> Maybe Text) -> Text -> Maybe Text
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> List Text -> Maybe Text
forall a. List a -> Maybe a
List.head)
List Text -> (List Text -> [NonEmpty Text]) -> [NonEmpty Text]
forall a b. a -> (a -> b) -> b
|> (Text -> Text) -> List Text -> [NonEmpty Text]
forall (f :: * -> *) b a.
(Foldable f, Eq b) =>
(a -> b) -> f a -> [NonEmpty a]
NonEmpty.groupWith Text -> Text
forall a. a -> a
identity
[NonEmpty Text] -> ([NonEmpty Text] -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> (NonEmpty Text -> Span -> Span) -> Span -> [NonEmpty Text] -> Span
forall a b. (a -> b -> b) -> b -> List a -> b
List.foldr
( \NonEmpty Text
xs ->
Text -> Int -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField
(Text
"redis." Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ NonEmpty Text -> Text
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty Text
xs Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
".count")
(NonEmpty Text -> Int
forall a. NonEmpty a -> Int
NonEmpty.length NonEmpty Text
xs)
)
Span
span'
fullBlob :: Value
fullBlob =
Details
redisInfo
Details -> (Details -> List Text) -> List Text
forall a b. a -> (a -> b) -> b
|> Details -> List Text
RedisCommands.commands
List Text -> (List Text -> Value) -> Value
forall a b. a -> (a -> b) -> b
|> List Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON
in Span
span
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Value -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"redis.commands" Value
fullBlob
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Maybe Text -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"redis.host" (Details -> Maybe Text
RedisCommands.host Details
redisInfo)
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Maybe Int -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"redis.port" (Details -> Maybe Int
RedisCommands.port Details
redisInfo)
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Span -> Span
addCommandCounts
data BatchEvent = BatchEvent
{ BatchEvent -> Text
batchevent_time :: Text,
BatchEvent -> Span
batchevent_data :: Span,
BatchEvent -> Int
batchevent_samplerate :: Int
}
deriving ((forall x. BatchEvent -> Rep BatchEvent x)
-> (forall x. Rep BatchEvent x -> BatchEvent) -> Generic BatchEvent
forall x. Rep BatchEvent x -> BatchEvent
forall x. BatchEvent -> Rep BatchEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchEvent x -> BatchEvent
$cfrom :: forall x. BatchEvent -> Rep BatchEvent x
Generic, Int -> BatchEvent -> ShowS
List BatchEvent -> ShowS
BatchEvent -> List Char
(Int -> BatchEvent -> ShowS)
-> (BatchEvent -> List Char)
-> (List BatchEvent -> ShowS)
-> Show BatchEvent
forall a.
(Int -> a -> ShowS) -> (a -> List Char) -> ([a] -> ShowS) -> Show a
showList :: List BatchEvent -> ShowS
$cshowList :: List BatchEvent -> ShowS
show :: BatchEvent -> List Char
$cshow :: BatchEvent -> List Char
showsPrec :: Int -> BatchEvent -> ShowS
$cshowsPrec :: Int -> BatchEvent -> ShowS
Show)
options :: Aeson.Options
options :: Options
options =
Options
Aeson.defaultOptions
{
fieldLabelModifier :: ShowS
Aeson.fieldLabelModifier = Int -> ShowS
forall a. Int -> List a -> List a
List.drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
Prelude.dropWhile (Char
'_' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=)
}
instance Aeson.ToJSON BatchEvent where
toJSON :: BatchEvent -> Value
toJSON = Options -> BatchEvent -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
options
data SharedTraceData = SharedTraceData
{
SharedTraceData -> Timer
timer :: Timer.Timer,
SharedTraceData -> Text
requestId :: Text,
SharedTraceData -> Span
initSpan :: Span,
SharedTraceData -> Maybe Text
endpoint :: Maybe Text,
SharedTraceData -> Int
sampleRate :: Int
}
newtype Span = Span (Dict.Dict Text JsonEncodable)
deriving ([Span] -> Encoding
[Span] -> Value
Span -> Encoding
Span -> Value
(Span -> Value)
-> (Span -> Encoding)
-> ([Span] -> Value)
-> ([Span] -> Encoding)
-> ToJSON Span
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Span] -> Encoding
$ctoEncodingList :: [Span] -> Encoding
toJSONList :: [Span] -> Value
$ctoJSONList :: [Span] -> Value
toEncoding :: Span -> Encoding
$ctoEncoding :: Span -> Encoding
toJSON :: Span -> Value
$ctoJSON :: Span -> Value
Aeson.ToJSON, Int -> Span -> ShowS
[Span] -> ShowS
Span -> List Char
(Int -> Span -> ShowS)
-> (Span -> List Char) -> ([Span] -> ShowS) -> Show Span
forall a.
(Int -> a -> ShowS) -> (a -> List Char) -> ([a] -> ShowS) -> Show a
showList :: [Span] -> ShowS
$cshowList :: [Span] -> ShowS
show :: Span -> List Char
$cshow :: Span -> List Char
showsPrec :: Int -> Span -> ShowS
$cshowsPrec :: Int -> Span -> ShowS
Show)
data JsonEncodable where
JsonEncodable :: Aeson.ToJSON a => a -> JsonEncodable
instance Aeson.ToJSON JsonEncodable where
toEncoding :: JsonEncodable -> Encoding
toEncoding (JsonEncodable a
x) = a -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding a
x
toJSON :: JsonEncodable -> Value
toJSON (JsonEncodable a
x) = a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
x
instance Show JsonEncodable where
show :: JsonEncodable -> List Char
show (JsonEncodable a
x) = Value -> List Char
forall a. Show a => a -> List Char
Prelude.show (a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
x)
emptySpan :: Span
emptySpan :: Span
emptySpan = Dict Text JsonEncodable -> Span
Span Dict Text JsonEncodable
forall k v. Dict k v
Dict.empty
addField :: Aeson.ToJSON a => Text -> a -> Span -> Span
addField :: Text -> a -> Span -> Span
addField Text
key a
val (Span Dict Text JsonEncodable
span) = Dict Text JsonEncodable -> Span
Span (Text
-> JsonEncodable
-> Dict Text JsonEncodable
-> Dict Text JsonEncodable
forall comparable v.
Ord comparable =>
comparable -> v -> Dict comparable v -> Dict comparable v
Dict.insert Text
key (a -> JsonEncodable
forall a. ToJSON a => a -> JsonEncodable
JsonEncodable a
val) Dict Text JsonEncodable
span)
newtype SpanId = SpanId Text
deriving ([SpanId] -> Encoding
[SpanId] -> Value
SpanId -> Encoding
SpanId -> Value
(SpanId -> Value)
-> (SpanId -> Encoding)
-> ([SpanId] -> Value)
-> ([SpanId] -> Encoding)
-> ToJSON SpanId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SpanId] -> Encoding
$ctoEncodingList :: [SpanId] -> Encoding
toJSONList :: [SpanId] -> Value
$ctoJSONList :: [SpanId] -> Value
toEncoding :: SpanId -> Encoding
$ctoEncoding :: SpanId -> Encoding
toJSON :: SpanId -> Value
$ctoJSON :: SpanId -> Value
Aeson.ToJSON, SpanId -> SpanId -> Bool
(SpanId -> SpanId -> Bool)
-> (SpanId -> SpanId -> Bool) -> Eq SpanId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanId -> SpanId -> Bool
$c/= :: SpanId -> SpanId -> Bool
== :: SpanId -> SpanId -> Bool
$c== :: SpanId -> SpanId -> Bool
Eq, Int -> SpanId -> ShowS
[SpanId] -> ShowS
SpanId -> List Char
(Int -> SpanId -> ShowS)
-> (SpanId -> List Char) -> ([SpanId] -> ShowS) -> Show SpanId
forall a.
(Int -> a -> ShowS) -> (a -> List Char) -> ([a] -> ShowS) -> Show a
showList :: [SpanId] -> ShowS
$cshowList :: [SpanId] -> ShowS
show :: SpanId -> List Char
$cshow :: SpanId -> List Char
showsPrec :: Int -> SpanId -> ShowS
$cshowsPrec :: Int -> SpanId -> ShowS
Show)
data Handler = Handler
{ Handler -> Manager
http :: HTTP.Manager,
Handler -> Settings
settings :: Settings,
Handler -> TracingSpan -> IO SendOrSample
makeSharedTraceData :: Platform.TracingSpan -> Prelude.IO SendOrSample
}
data SendOrSample
= SendToHoneycomb SharedTraceData
| SampledOut
handler :: Settings -> Prelude.IO Handler
handler :: Settings -> IO Handler
handler Settings
settings = do
Timer
timer <- IO Timer
Timer.mkTimer
Manager
http <- IO Manager
HTTP.TLS.getGlobalManager
Revision
revision <- IO Revision
getRevision
List Char
hostname' <- IO (List Char)
Network.HostName.getHostName
let baseSpan :: Span
baseSpan =
Span
emptySpan
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Text -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"service_name" (Settings -> Text
serviceName Settings
settings)
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Text -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"hostname" (List Char -> Text
Text.fromList List Char
hostname')
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Revision -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"revision" Revision
revision
Handler -> IO Handler
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
Handler :: Manager -> Settings -> (TracingSpan -> IO SendOrSample) -> Handler
Handler
{ http :: Manager
http = Manager
http,
settings :: Settings
settings = Settings
settings,
makeSharedTraceData :: TracingSpan -> IO SendOrSample
makeSharedTraceData = \TracingSpan
span -> do
(Bool
skipLogging, Int
sampleRate) <-
case TracingSpan -> Succeeded
Platform.succeeded TracingSpan
span of
Succeeded
Platform.Succeeded -> do
let probability :: Float
probability = TracingSpan -> Settings -> Float
deriveSampleRate TracingSpan
span Settings
settings
Float
roll <- (Float, Float) -> IO Float
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
Random.randomRIO (Float
0.0, Float
1.0)
(Bool, Int) -> IO (Bool, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Float
roll Float -> Float -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
> Float
probability, Float -> Int
round (Float
1 Float -> Float -> Float
/ Float
probability))
Succeeded
Platform.Failed -> (Bool, Int) -> IO (Bool, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Bool
False, Int
1)
Platform.FailedWith SomeException
_ -> (Bool, Int) -> IO (Bool, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Bool
False, Int
1)
UUID
uuid <- IO UUID
Data.UUID.V4.nextRandom
if Bool
skipLogging
then SendOrSample -> IO SendOrSample
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure SendOrSample
SampledOut
else
SendOrSample -> IO SendOrSample
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
(SendOrSample -> IO SendOrSample)
-> SendOrSample -> IO SendOrSample
forall a b. (a -> b) -> a -> b
<| SharedTraceData -> SendOrSample
SendToHoneycomb
SharedTraceData :: Timer -> Text -> Span -> Maybe Text -> Int -> SharedTraceData
SharedTraceData
{ Timer
timer :: Timer
timer :: Timer
timer,
Int
sampleRate :: Int
sampleRate :: Int
sampleRate,
requestId :: Text
requestId = UUID -> Text
Data.UUID.toText UUID
uuid,
endpoint :: Maybe Text
endpoint = TracingSpan -> Maybe Text
getSpanEndpoint TracingSpan
span,
initSpan :: Span
initSpan =
Span
baseSpan
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Float -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"apdex" (Settings -> TracingSpan -> Float
calculateApdex Settings
settings TracingSpan
span)
Span -> (Span -> Span) -> Span
forall a b. a -> (a -> b) -> b
|> Text -> Text -> Span -> Span
forall a. ToJSON a => Text -> a -> Span -> Span
addField Text
"trace.trace_id" (UUID -> Text
Data.UUID.toText UUID
uuid)
}
}
newtype Revision = Revision Text
deriving (Int -> Revision -> ShowS
[Revision] -> ShowS
Revision -> List Char
(Int -> Revision -> ShowS)
-> (Revision -> List Char)
-> ([Revision] -> ShowS)
-> Show Revision
forall a.
(Int -> a -> ShowS) -> (a -> List Char) -> ([a] -> ShowS) -> Show a
showList :: [Revision] -> ShowS
$cshowList :: [Revision] -> ShowS
show :: Revision -> List Char
$cshow :: Revision -> List Char
showsPrec :: Int -> Revision -> ShowS
$cshowsPrec :: Int -> Revision -> ShowS
Show, [Revision] -> Encoding
[Revision] -> Value
Revision -> Encoding
Revision -> Value
(Revision -> Value)
-> (Revision -> Encoding)
-> ([Revision] -> Value)
-> ([Revision] -> Encoding)
-> ToJSON Revision
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Revision] -> Encoding
$ctoEncodingList :: [Revision] -> Encoding
toJSONList :: [Revision] -> Value
$ctoJSONList :: [Revision] -> Value
toEncoding :: Revision -> Encoding
$ctoEncoding :: Revision -> Encoding
toJSON :: Revision -> Value
$ctoJSON :: Revision -> Value
Aeson.ToJSON)
getRevision :: Prelude.IO Revision
getRevision :: IO Revision
getRevision = do
Either SomeException Text
eitherRevision <- IO Text -> IO (Either SomeException Text)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
Exception.tryAny (IO Text -> IO (Either SomeException Text))
-> IO Text -> IO (Either SomeException Text)
forall a b. (a -> b) -> a -> b
<| List Char -> IO Text
Data.Text.IO.readFile List Char
"revision"
case Either SomeException Text
eitherRevision of
Prelude.Left SomeException
_err -> Revision -> IO Revision
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Text -> Revision
Revision Text
"no revision file found")
Prelude.Right Text
version -> Revision -> IO Revision
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Text -> Revision
Revision Text
version)
data Settings = Settings
{
Settings -> Secret Method
apiKey :: Log.Secret ByteString.ByteString,
Settings -> Text
datasetName :: Text,
Settings -> Text
serviceName :: Text,
Settings -> Float
fractionOfSuccessRequestsLogged :: Float,
Settings -> Int
apdexTimeMs :: Int,
Settings -> Float -> TracingSpan -> Float
modifyFractionOfSuccessRequestsLogged :: Float -> Platform.TracingSpan -> Float,
Settings -> Int -> TracingSpan -> Int
modifyApdexTimeMs :: Int -> Platform.TracingSpan -> Int
}
decoder :: Environment.Decoder Settings
decoder :: Decoder Settings
decoder =
(Secret Method
-> Text
-> Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> Decoder
(Secret Method
-> Text
-> Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Secret Method
-> Text
-> Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings
Settings
Decoder
(Secret Method
-> Text
-> Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> (Decoder
(Secret Method
-> Text
-> Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> Decoder
(Text
-> Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings))
-> Decoder
(Text
-> Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
forall a b. a -> (a -> b) -> b
|> Decoder (Secret Method)
-> Decoder
(Secret Method
-> Text
-> Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> Decoder
(Text
-> Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap Decoder (Secret Method)
honeycombApiKeyDecoder
Decoder
(Text
-> Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> (Decoder
(Text
-> Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> Decoder
(Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings))
-> Decoder
(Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
forall a b. a -> (a -> b) -> b
|> Decoder Text
-> Decoder
(Text
-> Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> Decoder
(Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap Decoder Text
datasetNameDecoder
Decoder
(Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> (Decoder
(Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> Decoder
(Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings))
-> Decoder
(Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
forall a b. a -> (a -> b) -> b
|> Decoder Text
-> Decoder
(Text
-> Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> Decoder
(Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap Decoder Text
honeycombAppNameDecoder
Decoder
(Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> (Decoder
(Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> Decoder
(Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings))
-> Decoder
(Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
forall a b. a -> (a -> b) -> b
|> Decoder Float
-> Decoder
(Float
-> Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> Decoder
(Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap Decoder Float
fractionOfSuccessRequestsLoggedDecoder
Decoder
(Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> (Decoder
(Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> Decoder
((Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int) -> Settings))
-> Decoder
((Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int) -> Settings)
forall a b. a -> (a -> b) -> b
|> Decoder Int
-> Decoder
(Int
-> (Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int)
-> Settings)
-> Decoder
((Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int) -> Settings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap Decoder Int
apdexTimeMsDecoder
Decoder
((Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int) -> Settings)
-> (Decoder
((Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int) -> Settings)
-> Decoder ((Int -> TracingSpan -> Int) -> Settings))
-> Decoder ((Int -> TracingSpan -> Int) -> Settings)
forall a b. a -> (a -> b) -> b
|> Decoder (Float -> TracingSpan -> Float)
-> Decoder
((Float -> TracingSpan -> Float)
-> (Int -> TracingSpan -> Int) -> Settings)
-> Decoder ((Int -> TracingSpan -> Int) -> Settings)
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap ((Float -> TracingSpan -> Float)
-> Decoder (Float -> TracingSpan -> Float)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Float -> TracingSpan -> Float
forall a b. a -> b -> a
always)
Decoder ((Int -> TracingSpan -> Int) -> Settings)
-> (Decoder ((Int -> TracingSpan -> Int) -> Settings)
-> Decoder Settings)
-> Decoder Settings
forall a b. a -> (a -> b) -> b
|> Decoder (Int -> TracingSpan -> Int)
-> Decoder ((Int -> TracingSpan -> Int) -> Settings)
-> Decoder Settings
forall (m :: * -> *) a b. Applicative m => m a -> m (a -> b) -> m b
andMap ((Int -> TracingSpan -> Int) -> Decoder (Int -> TracingSpan -> Int)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Int -> TracingSpan -> Int
forall a b. a -> b -> a
always)
honeycombApiKeyDecoder :: Environment.Decoder (Log.Secret ByteString.ByteString)
honeycombApiKeyDecoder :: Decoder (Secret Method)
honeycombApiKeyDecoder =
Variable -> Parser (Secret Method) -> Decoder (Secret Method)
forall a. Variable -> Parser a -> Decoder a
Environment.variable
Variable :: Text -> Text -> Text -> Variable
Environment.Variable
{ name :: Text
Environment.name = Text
"HONEYCOMB_API_KEY",
description :: Text
Environment.description = Text
"The API key for Honeycomb",
defaultValue :: Text
Environment.defaultValue = Text
"*****"
}
(Parser Text
Environment.text Parser Text -> (Parser Text -> Parser Method) -> Parser Method
forall a b. a -> (a -> b) -> b
|> (Text -> Method) -> Parser Text -> Parser Method
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> Method
Encoding.encodeUtf8 Parser Method
-> (Parser Method -> Parser (Secret Method))
-> Parser (Secret Method)
forall a b. a -> (a -> b) -> b
|> Parser Method -> Parser (Secret Method)
forall a. Parser a -> Parser (Secret a)
Environment.secret)
datasetNameDecoder :: Environment.Decoder Text
datasetNameDecoder :: Decoder Text
datasetNameDecoder =
Variable -> Parser Text -> Decoder Text
forall a. Variable -> Parser a -> Decoder a
Environment.variable
Variable :: Text -> Text -> Text -> Variable
Environment.Variable
{ name :: Text
Environment.name = Text
"HONEYCOMB_DATASET",
description :: Text
Environment.description = Text
"Name of the dataset honeycomb should log to.",
defaultValue :: Text
Environment.defaultValue = Text
"dataset"
}
Parser Text
Environment.text
honeycombAppNameDecoder :: Environment.Decoder Text
honeycombAppNameDecoder :: Decoder Text
honeycombAppNameDecoder =
Variable -> Parser Text -> Decoder Text
forall a. Variable -> Parser a -> Decoder a
Environment.variable
Variable :: Text -> Text -> Text -> Variable
Environment.Variable
{ name :: Text
Environment.name = Text
"HONEYCOMB_SERVICE_NAME",
description :: Text
Environment.description = Text
"Variable that sets the honeycomb service name.",
defaultValue :: Text
Environment.defaultValue = Text
"service"
}
Parser Text
Environment.text
fractionOfSuccessRequestsLoggedDecoder :: Environment.Decoder Float
fractionOfSuccessRequestsLoggedDecoder :: Decoder Float
fractionOfSuccessRequestsLoggedDecoder =
Variable -> Parser Float -> Decoder Float
forall a. Variable -> Parser a -> Decoder a
Environment.variable
Variable :: Text -> Text -> Text -> Variable
Environment.Variable
{ name :: Text
Environment.name = Text
"HONEYCOMB_FRACTION_OF_SUCCESS_REQUESTS_LOGGED",
description :: Text
Environment.description = Text
"The fraction of successful requests logged. Defaults to logging all successful requests.",
defaultValue :: Text
Environment.defaultValue = Text
"1"
}
Parser Float
Environment.float
apdexTimeMsDecoder :: Environment.Decoder Int
apdexTimeMsDecoder :: Decoder Int
apdexTimeMsDecoder =
Variable -> Parser Int -> Decoder Int
forall a. Variable -> Parser a -> Decoder a
Environment.variable
Variable :: Text -> Text -> Text -> Variable
Environment.Variable
{ name :: Text
Environment.name = Text
"HONEYCOMB_APDEX_TIME_IN_MILLISECONDS",
description :: Text
Environment.description = Text
"The T value in the apdex, the time in milliseconds in which a healthy request should complete.",
defaultValue :: Text
Environment.defaultValue = Text
"100"
}
Parser Int
forall a. Integral a => Parser a
Environment.int