{-# LANGUAGE TupleSections #-}
module Freckle.App.Stats
(
StatsSettings
, defaultStatsSettings
, setStatsSettingsTags
, envParseStatsSettings
, StatsClient
, tagsL
, withStatsClient
, HasStatsClient (..)
, Gauges
, Gauge
, dbConnections
, dbEnqueuedAndProcessing
, withGauge
, lookupGauge
, incGauge
, decGauge
, tagged
, increment
, counter
, gauge
, histogram
, histogramSince
, histogramSinceMs
) where
import Freckle.App.Prelude
import Blammo.Logging
import Control.Lens (Lens', lens, to, view, (&), (.~), (<>~))
import Control.Monad.Except (runExceptT)
import Control.Monad.Reader (local)
import Data.Aeson (Value (..))
import Data.String
import Data.Time (diffUTCTime)
import Freckle.App.Ecs
import qualified Freckle.App.Env as Env
import qualified Network.StatsD.Datadog as Datadog
import System.IO (hPutStrLn, stderr)
import qualified System.Metrics.Gauge as EKG
import UnliftIO.Exception (bracket_)
import Yesod.Core.Lens
import Yesod.Core.Types (HandlerData)
data StatsSettings = StatsSettings
{ StatsSettings -> Bool
amsEnabled :: Bool
, StatsSettings -> DogStatsSettings
amsSettings :: Datadog.DogStatsSettings
, StatsSettings -> [(Text, Text)]
amsTags :: [(Text, Text)]
}
defaultStatsSettings :: StatsSettings
defaultStatsSettings :: StatsSettings
defaultStatsSettings =
StatsSettings
{ amsEnabled :: Bool
amsEnabled = Bool
False
, amsSettings :: DogStatsSettings
amsSettings = DogStatsSettings
Datadog.defaultSettings
, amsTags :: [(Text, Text)]
amsTags = []
}
setStatsSettingsTags :: [(Text, Text)] -> StatsSettings -> StatsSettings
setStatsSettingsTags :: [(Text, Text)] -> StatsSettings -> StatsSettings
setStatsSettingsTags [(Text, Text)]
x StatsSettings
settings = StatsSettings
settings {amsTags = x}
envParseStatsSettings :: Env.Parser Env.Error StatsSettings
envParseStatsSettings :: Parser Error StatsSettings
envParseStatsSettings =
Bool -> DogStatsSettings -> [(Text, Text)] -> StatsSettings
StatsSettings
(Bool -> DogStatsSettings -> [(Text, Text)] -> StatsSettings)
-> Parser Error Bool
-> Parser
Error (DogStatsSettings -> [(Text, Text)] -> StatsSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> Mod Flag Bool -> Parser Error Bool
forall e. HostName -> Mod Flag Bool -> Parser e Bool
Env.switch HostName
"DOGSTATSD_ENABLED" Mod Flag Bool
forall a. Monoid a => a
mempty
Parser Error (DogStatsSettings -> [(Text, Text)] -> StatsSettings)
-> Parser Error DogStatsSettings
-> Parser Error ([(Text, Text)] -> StatsSettings)
forall a b.
Parser Error (a -> b) -> Parser Error a -> Parser Error b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Maybe HostName -> Maybe Int -> DogStatsSettings
buildSettings
(Maybe HostName -> Maybe Int -> DogStatsSettings)
-> Parser Error (Maybe HostName)
-> Parser Error (Maybe Int -> DogStatsSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Error HostName -> Parser Error (Maybe HostName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Reader Error HostName
-> HostName -> Mod Var HostName -> Parser Error HostName
forall e a.
AsUnset e =>
Reader e a -> HostName -> Mod Var a -> Parser e a
Env.var Reader Error HostName
forall s e. IsString s => Reader e s
Env.str HostName
"DOGSTATSD_HOST" Mod Var HostName
forall a. Monoid a => a
mempty)
Parser Error (Maybe Int -> DogStatsSettings)
-> Parser Error (Maybe Int) -> Parser Error DogStatsSettings
forall a b.
Parser Error (a -> b) -> Parser Error a -> Parser Error b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error Int -> Parser Error (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Reader Error Int -> HostName -> Mod Var Int -> Parser Error Int
forall e a.
AsUnset e =>
Reader e a -> HostName -> Mod Var a -> Parser e a
Env.var Reader Error Int
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto HostName
"DOGSTATSD_PORT" Mod Var Int
forall a. Monoid a => a
mempty)
)
Parser Error ([(Text, Text)] -> StatsSettings)
-> Parser Error [(Text, Text)] -> Parser Error StatsSettings
forall a b.
Parser Error (a -> b) -> Parser Error a -> Parser Error b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Maybe Text
-> Maybe Text -> Maybe Text -> [(Text, Text)] -> [(Text, Text)]
forall {t} {a}.
IsString t =>
Maybe a -> Maybe a -> Maybe a -> [(t, a)] -> [(t, a)]
buildTags
(Maybe Text
-> Maybe Text -> Maybe Text -> [(Text, Text)] -> [(Text, Text)])
-> Parser Error (Maybe Text)
-> Parser
Error
(Maybe Text -> Maybe Text -> [(Text, Text)] -> [(Text, Text)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Error Text -> Parser Error (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Reader Error Text -> HostName -> Mod Var Text -> Parser Error Text
forall e a.
AsUnset e =>
Reader e a -> HostName -> Mod Var a -> Parser e a
Env.var Reader Error Text
forall e s. (AsEmpty e, IsString s) => Reader e s
Env.nonempty HostName
"DD_ENV" Mod Var Text
forall a. Monoid a => a
mempty)
Parser
Error
(Maybe Text -> Maybe Text -> [(Text, Text)] -> [(Text, Text)])
-> Parser Error (Maybe Text)
-> Parser Error (Maybe Text -> [(Text, Text)] -> [(Text, Text)])
forall a b.
Parser Error (a -> b) -> Parser Error a -> Parser Error b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error Text -> Parser Error (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Reader Error Text -> HostName -> Mod Var Text -> Parser Error Text
forall e a.
AsUnset e =>
Reader e a -> HostName -> Mod Var a -> Parser e a
Env.var Reader Error Text
forall e s. (AsEmpty e, IsString s) => Reader e s
Env.nonempty HostName
"DD_SERVICE" Mod Var Text
forall a. Monoid a => a
mempty)
Parser Error (Maybe Text -> [(Text, Text)] -> [(Text, Text)])
-> Parser Error (Maybe Text)
-> Parser Error ([(Text, Text)] -> [(Text, Text)])
forall a b.
Parser Error (a -> b) -> Parser Error a -> Parser Error b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error Text -> Parser Error (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Reader Error Text -> HostName -> Mod Var Text -> Parser Error Text
forall e a.
AsUnset e =>
Reader e a -> HostName -> Mod Var a -> Parser e a
Env.var Reader Error Text
forall e s. (AsEmpty e, IsString s) => Reader e s
Env.nonempty HostName
"DD_VERSION" Mod Var Text
forall a. Monoid a => a
mempty)
Parser Error ([(Text, Text)] -> [(Text, Text)])
-> Parser Error [(Text, Text)] -> Parser Error [(Text, Text)]
forall a b.
Parser Error (a -> b) -> Parser Error a -> Parser Error b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error [(Text, Text)]
-> HostName
-> Mod Var [(Text, Text)]
-> Parser Error [(Text, Text)]
forall e a.
AsUnset e =>
Reader e a -> HostName -> Mod Var a -> Parser e a
Env.var Reader Error [(Text, Text)]
Env.keyValues HostName
"DOGSTATSD_TAGS" ([(Text, Text)] -> Mod Var [(Text, Text)]
forall a. a -> Mod Var a
Env.def [])
)
where
buildSettings :: Maybe HostName -> Maybe Int -> DogStatsSettings
buildSettings Maybe HostName
mHost Maybe Int
mPort =
DogStatsSettings
Datadog.defaultSettings
DogStatsSettings
-> (DogStatsSettings -> DogStatsSettings) -> DogStatsSettings
forall a b. a -> (a -> b) -> b
& (DogStatsSettings -> DogStatsSettings)
-> (HostName -> DogStatsSettings -> DogStatsSettings)
-> Maybe HostName
-> DogStatsSettings
-> DogStatsSettings
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DogStatsSettings -> DogStatsSettings
forall a. a -> a
id ((HostName -> Identity HostName)
-> DogStatsSettings -> Identity DogStatsSettings
forall s a. HasHost s a => Lens' s a
Lens' DogStatsSettings HostName
Datadog.host ((HostName -> Identity HostName)
-> DogStatsSettings -> Identity DogStatsSettings)
-> HostName -> DogStatsSettings -> DogStatsSettings
forall s t a b. ASetter s t a b -> b -> s -> t
.~) Maybe HostName
mHost
(DogStatsSettings -> DogStatsSettings)
-> (DogStatsSettings -> DogStatsSettings)
-> DogStatsSettings
-> DogStatsSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DogStatsSettings -> DogStatsSettings)
-> (Int -> DogStatsSettings -> DogStatsSettings)
-> Maybe Int
-> DogStatsSettings
-> DogStatsSettings
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DogStatsSettings -> DogStatsSettings
forall a. a -> a
id ((Int -> Identity Int)
-> DogStatsSettings -> Identity DogStatsSettings
forall s a. HasPort s a => Lens' s a
Lens' DogStatsSettings Int
Datadog.port ((Int -> Identity Int)
-> DogStatsSettings -> Identity DogStatsSettings)
-> Int -> DogStatsSettings -> DogStatsSettings
forall s t a b. ASetter s t a b -> b -> s -> t
.~) Maybe Int
mPort
buildTags :: Maybe a -> Maybe a -> Maybe a -> [(t, a)] -> [(t, a)]
buildTags Maybe a
mEnv Maybe a
mService Maybe a
mVersion [(t, a)]
tags =
[Maybe (t, a)] -> [(t, a)]
forall a. [Maybe a] -> [a]
catMaybes
[ (t
"env",) (a -> (t, a)) -> Maybe a -> Maybe (t, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mEnv
, (t
"environment",) (a -> (t, a)) -> Maybe a -> Maybe (t, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mEnv
, (t
"service",) (a -> (t, a)) -> Maybe a -> Maybe (t, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mService
, (t
"version",) (a -> (t, a)) -> Maybe a -> Maybe (t, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mVersion
]
[(t, a)] -> [(t, a)] -> [(t, a)]
forall a. Semigroup a => a -> a -> a
<> [(t, a)]
tags
data Gauges = Gauges
{ Gauges -> Gauge
gdbConnections :: Gauge
, Gauges -> Gauge
gdbEnqueuedAndProcessing :: Gauge
}
data Gauge = Gauge
{ Gauge -> Text
gName :: Text
, Gauge -> Gauge
gGauge :: EKG.Gauge
}
dbConnections :: Gauges -> Gauge
dbConnections :: Gauges -> Gauge
dbConnections = Gauges -> Gauge
gdbConnections
dbEnqueuedAndProcessing :: Gauges -> Gauge
dbEnqueuedAndProcessing :: Gauges -> Gauge
dbEnqueuedAndProcessing = Gauges -> Gauge
gdbEnqueuedAndProcessing
data StatsClient = StatsClient
{ StatsClient -> StatsClient
scClient :: Datadog.StatsClient
, StatsClient -> [(Text, Text)]
scTags :: [(Text, Text)]
, StatsClient -> Gauges
scGauges :: Gauges
}
tagsL :: Lens' StatsClient [(Text, Text)]
tagsL :: Lens' StatsClient [(Text, Text)]
tagsL = (StatsClient -> [(Text, Text)])
-> (StatsClient -> [(Text, Text)] -> StatsClient)
-> Lens' StatsClient [(Text, Text)]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens StatsClient -> [(Text, Text)]
scTags ((StatsClient -> [(Text, Text)] -> StatsClient)
-> Lens' StatsClient [(Text, Text)])
-> (StatsClient -> [(Text, Text)] -> StatsClient)
-> Lens' StatsClient [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ \StatsClient
x [(Text, Text)]
y -> StatsClient
x {scTags = y}
gaugesL :: Lens' StatsClient Gauges
gaugesL :: Lens' StatsClient Gauges
gaugesL = (StatsClient -> Gauges)
-> (StatsClient -> Gauges -> StatsClient)
-> Lens' StatsClient Gauges
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens StatsClient -> Gauges
scGauges ((StatsClient -> Gauges -> StatsClient)
-> Lens' StatsClient Gauges)
-> (StatsClient -> Gauges -> StatsClient)
-> Lens' StatsClient Gauges
forall a b. (a -> b) -> a -> b
$ \StatsClient
x Gauges
y -> StatsClient
x {scGauges = y}
class HasStatsClient env where
statsClientL :: Lens' env StatsClient
instance HasStatsClient StatsClient where
statsClientL :: Lens' StatsClient StatsClient
statsClientL = (StatsClient -> f StatsClient) -> StatsClient -> f StatsClient
forall a. a -> a
id
instance HasStatsClient site => HasStatsClient (HandlerData child site) where
statsClientL :: Lens' (HandlerData child site) StatsClient
statsClientL = (RunHandlerEnv child site -> f (RunHandlerEnv child site))
-> HandlerData child site -> f (HandlerData child site)
forall child site (f :: * -> *).
Functor f =>
(RunHandlerEnv child site -> f (RunHandlerEnv child site))
-> HandlerData child site -> f (HandlerData child site)
envL ((RunHandlerEnv child site -> f (RunHandlerEnv child site))
-> HandlerData child site -> f (HandlerData child site))
-> ((StatsClient -> f StatsClient)
-> RunHandlerEnv child site -> f (RunHandlerEnv child site))
-> (StatsClient -> f StatsClient)
-> HandlerData child site
-> f (HandlerData child site)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (site -> f site)
-> RunHandlerEnv child site -> f (RunHandlerEnv child site)
forall child site (f :: * -> *).
Functor f =>
(site -> f site)
-> RunHandlerEnv child site -> f (RunHandlerEnv child site)
siteL ((site -> f site)
-> RunHandlerEnv child site -> f (RunHandlerEnv child site))
-> ((StatsClient -> f StatsClient) -> site -> f site)
-> (StatsClient -> f StatsClient)
-> RunHandlerEnv child site
-> f (RunHandlerEnv child site)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StatsClient -> f StatsClient) -> site -> f site
forall env. HasStatsClient env => Lens' env StatsClient
Lens' site StatsClient
statsClientL
withStatsClient
:: (MonadMask m, MonadUnliftIO m)
=> StatsSettings
-> (StatsClient -> m a)
-> m a
withStatsClient :: forall (m :: * -> *) a.
(MonadMask m, MonadUnliftIO m) =>
StatsSettings -> (StatsClient -> m a) -> m a
withStatsClient StatsSettings {Bool
[(Text, Text)]
DogStatsSettings
amsEnabled :: StatsSettings -> Bool
amsSettings :: StatsSettings -> DogStatsSettings
amsTags :: StatsSettings -> [(Text, Text)]
amsEnabled :: Bool
amsSettings :: DogStatsSettings
amsTags :: [(Text, Text)]
..} StatsClient -> m a
f = do
Gauges
gauges <- IO Gauges -> m Gauges
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Gauges -> m Gauges) -> IO Gauges -> m Gauges
forall a b. (a -> b) -> a -> b
$ do
Gauge
gdbConnections <- Text -> Gauge -> Gauge
Gauge Text
"active_pool_connections" (Gauge -> Gauge) -> IO Gauge -> IO Gauge
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Gauge
EKG.new
Gauge
gdbEnqueuedAndProcessing <- Text -> Gauge -> Gauge
Gauge Text
"queries_enqueued_and_processing" (Gauge -> Gauge) -> IO Gauge -> IO Gauge
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Gauge
EKG.new
Gauges -> IO Gauges
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Gauges {Gauge
gdbConnections :: Gauge
gdbEnqueuedAndProcessing :: Gauge
gdbConnections :: Gauge
gdbEnqueuedAndProcessing :: Gauge
..}
if Bool
amsEnabled
then do
[(Text, Text)]
tags <- ([(Text, Text)]
amsTags [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>) ([(Text, Text)] -> [(Text, Text)])
-> m [(Text, Text)] -> m [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [(Text, Text)]
forall (m :: * -> *). MonadIO m => m [(Text, Text)]
getEcsMetadataTags
DogStatsSettings -> (StatsClient -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
DogStatsSettings -> (StatsClient -> m a) -> m a
Datadog.withDogStatsD DogStatsSettings
amsSettings ((StatsClient -> m a) -> m a) -> (StatsClient -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \StatsClient
client ->
[Pair] -> m a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Pair] -> m a -> m a
withThreadContext (((Text, Text) -> Pair) -> [(Text, Text)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Pair
forall {p :: * -> * -> *} {b}.
(Bifunctor p, IsString b) =>
p Text Text -> p b Value
toPair [(Text, Text)]
tags) (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$
StatsClient -> m a
f
StatsClient
{ scClient :: StatsClient
scClient = StatsClient
client
, scTags :: [(Text, Text)]
scTags = [(Text, Text)]
tags
, scGauges :: Gauges
scGauges = Gauges
gauges
}
else do
StatsClient -> m a
f (StatsClient -> m a) -> StatsClient -> m a
forall a b. (a -> b) -> a -> b
$
StatsClient
{ scClient :: StatsClient
scClient = StatsClient
Datadog.Dummy
, scTags :: [(Text, Text)]
scTags = [(Text, Text)]
amsTags
, scGauges :: Gauges
scGauges = Gauges
gauges
}
where
toPair :: p Text Text -> p b Value
toPair = (Text -> b) -> (Text -> Value) -> p Text Text -> p b Value
forall a b c d. (a -> b) -> (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (HostName -> b
forall a. IsString a => HostName -> a
fromString (HostName -> b) -> (Text -> HostName) -> Text -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HostName
unpack) Text -> Value
String
withGauge
:: (MonadReader app m, HasStatsClient app, MonadUnliftIO m)
=> (Gauges -> Gauge)
-> m a
-> m a
withGauge :: forall app (m :: * -> *) a.
(MonadReader app m, HasStatsClient app, MonadUnliftIO m) =>
(Gauges -> Gauge) -> m a -> m a
withGauge Gauges -> Gauge
getGauge m a
f = do
Gauge
gauge' <- (Gauges -> Gauge) -> m Gauge
forall app (m :: * -> *).
(MonadReader app m, HasStatsClient app) =>
(Gauges -> Gauge) -> m Gauge
lookupGauge Gauges -> Gauge
getGauge
m () -> m () -> m a -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracket_ (Gauge -> m ()
forall {app} {m :: * -> *}.
(MonadReader app m, HasStatsClient app, MonadUnliftIO m) =>
Gauge -> m ()
inc Gauge
gauge') (Gauge -> m ()
forall {app} {m :: * -> *}.
(MonadReader app m, HasStatsClient app, MonadUnliftIO m) =>
Gauge -> m ()
dec Gauge
gauge') m a
f
where
inc :: Gauge -> m ()
inc = Gauge -> m ()
forall {app} {m :: * -> *}.
(MonadReader app m, HasStatsClient app, MonadUnliftIO m) =>
Gauge -> m ()
incGauge
dec :: Gauge -> m ()
dec = Gauge -> m ()
forall {app} {m :: * -> *}.
(MonadReader app m, HasStatsClient app, MonadUnliftIO m) =>
Gauge -> m ()
decGauge
lookupGauge
:: (MonadReader app m, HasStatsClient app)
=> (Gauges -> Gauge)
-> m Gauge
lookupGauge :: forall app (m :: * -> *).
(MonadReader app m, HasStatsClient app) =>
(Gauges -> Gauge) -> m Gauge
lookupGauge Gauges -> Gauge
accessor = Getting Gauge app Gauge -> m Gauge
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Gauge app Gauge -> m Gauge)
-> Getting Gauge app Gauge -> m Gauge
forall a b. (a -> b) -> a -> b
$ (StatsClient -> Const Gauge StatsClient) -> app -> Const Gauge app
forall env. HasStatsClient env => Lens' env StatsClient
Lens' app StatsClient
statsClientL ((StatsClient -> Const Gauge StatsClient)
-> app -> Const Gauge app)
-> ((Gauge -> Const Gauge Gauge)
-> StatsClient -> Const Gauge StatsClient)
-> Getting Gauge app Gauge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Gauges -> Const Gauge Gauges)
-> StatsClient -> Const Gauge StatsClient
Lens' StatsClient Gauges
gaugesL ((Gauges -> Const Gauge Gauges)
-> StatsClient -> Const Gauge StatsClient)
-> ((Gauge -> Const Gauge Gauge) -> Gauges -> Const Gauge Gauges)
-> (Gauge -> Const Gauge Gauge)
-> StatsClient
-> Const Gauge StatsClient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Gauges -> Gauge)
-> (Gauge -> Const Gauge Gauge) -> Gauges -> Const Gauge Gauges
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Gauges -> Gauge
accessor
incGauge
:: (MonadReader app m, HasStatsClient app, MonadUnliftIO m)
=> Gauge
-> m ()
incGauge :: forall {app} {m :: * -> *}.
(MonadReader app m, HasStatsClient app, MonadUnliftIO m) =>
Gauge -> m ()
incGauge g :: Gauge
g@Gauge {Text
Gauge
gName :: Gauge -> Text
gGauge :: Gauge -> Gauge
gName :: Text
gGauge :: Gauge
..} = do
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Gauge -> IO ()
EKG.inc Gauge
gGauge
Gauge -> m ()
forall {app} {m :: * -> *}.
(MonadReader app m, HasStatsClient app, MonadUnliftIO m) =>
Gauge -> m ()
publishGauge Gauge
g
decGauge
:: (MonadReader app m, HasStatsClient app, MonadUnliftIO m)
=> Gauge
-> m ()
decGauge :: forall {app} {m :: * -> *}.
(MonadReader app m, HasStatsClient app, MonadUnliftIO m) =>
Gauge -> m ()
decGauge g :: Gauge
g@Gauge {Text
Gauge
gName :: Gauge -> Text
gGauge :: Gauge -> Gauge
gName :: Text
gGauge :: Gauge
..} = do
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Gauge -> IO ()
EKG.dec Gauge
gGauge
Gauge -> m ()
forall {app} {m :: * -> *}.
(MonadReader app m, HasStatsClient app, MonadUnliftIO m) =>
Gauge -> m ()
publishGauge Gauge
g
publishGauge
:: (MonadReader app m, HasStatsClient app, MonadUnliftIO m)
=> Gauge
-> m ()
publishGauge :: forall {app} {m :: * -> *}.
(MonadReader app m, HasStatsClient app, MonadUnliftIO m) =>
Gauge -> m ()
publishGauge Gauge {Text
Gauge
gName :: Gauge -> Text
gGauge :: Gauge -> Gauge
gName :: Text
gGauge :: Gauge
..} = do
Int64
n <- IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Gauge -> IO Int64
EKG.read Gauge
gGauge
Text -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Double -> m ()
gauge Text
gName (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n
tagged
:: (MonadReader env m, HasStatsClient env) => [(Text, Text)] -> m a -> m a
tagged :: forall env (m :: * -> *) a.
(MonadReader env m, HasStatsClient env) =>
[(Text, Text)] -> m a -> m a
tagged [(Text, Text)]
tags = (env -> env) -> m a -> m a
forall a. (env -> env) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((env -> env) -> m a -> m a) -> (env -> env) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ (StatsClient -> Identity StatsClient) -> env -> Identity env
forall env. HasStatsClient env => Lens' env StatsClient
Lens' env StatsClient
statsClientL ((StatsClient -> Identity StatsClient) -> env -> Identity env)
-> (([(Text, Text)] -> Identity [(Text, Text)])
-> StatsClient -> Identity StatsClient)
-> ([(Text, Text)] -> Identity [(Text, Text)])
-> env
-> Identity env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, Text)] -> Identity [(Text, Text)])
-> StatsClient -> Identity StatsClient
Lens' StatsClient [(Text, Text)]
tagsL (([(Text, Text)] -> Identity [(Text, Text)])
-> env -> Identity env)
-> [(Text, Text)] -> env -> env
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [(Text, Text)]
tags
increment
:: (MonadUnliftIO m, MonadReader env m, HasStatsClient env) => Text -> m ()
increment :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> m ()
increment Text
name = Text -> Int -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Int -> m ()
counter Text
name Int
1
counter
:: (MonadUnliftIO m, MonadReader env m, HasStatsClient env)
=> Text
-> Int
-> m ()
counter :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Int -> m ()
counter = MetricType -> Text -> Int -> m ()
forall (m :: * -> *) env v.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env,
ToMetricValue v) =>
MetricType -> Text -> v -> m ()
sendMetric MetricType
Datadog.Counter
gauge
:: (MonadUnliftIO m, MonadReader env m, HasStatsClient env)
=> Text
-> Double
-> m ()
gauge :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Double -> m ()
gauge = MetricType -> Text -> Double -> m ()
forall (m :: * -> *) env v.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env,
ToMetricValue v) =>
MetricType -> Text -> v -> m ()
sendMetric MetricType
Datadog.Gauge
histogram
:: ( MonadUnliftIO m
, MonadReader env m
, HasStatsClient env
, Datadog.ToMetricValue n
)
=> Text
-> n
-> m ()
histogram :: forall (m :: * -> *) env n.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env,
ToMetricValue n) =>
Text -> n -> m ()
histogram = MetricType -> Text -> n -> m ()
forall (m :: * -> *) env v.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env,
ToMetricValue v) =>
MetricType -> Text -> v -> m ()
sendMetric MetricType
Datadog.Histogram
histogramSince
:: (MonadUnliftIO m, MonadReader env m, HasStatsClient env)
=> Text
-> UTCTime
-> m ()
histogramSince :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> UTCTime -> m ()
histogramSince = (NominalDiffTime -> Int) -> Text -> UTCTime -> m ()
forall (m :: * -> *) env n.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env,
ToMetricValue n) =>
(NominalDiffTime -> n) -> Text -> UTCTime -> m ()
histogramSinceBy NominalDiffTime -> Int
forall {w}. RealFrac w => w -> Int
toSeconds where toSeconds :: w -> Int
toSeconds = forall a b. (RealFrac a, Integral b) => a -> b
round @_ @Int
histogramSinceMs
:: (MonadUnliftIO m, MonadReader env m, HasStatsClient env)
=> Text
-> UTCTime
-> m ()
histogramSinceMs :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> UTCTime -> m ()
histogramSinceMs = (NominalDiffTime -> Double) -> Text -> UTCTime -> m ()
forall (m :: * -> *) env n.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env,
ToMetricValue n) =>
(NominalDiffTime -> n) -> Text -> UTCTime -> m ()
histogramSinceBy NominalDiffTime -> Double
forall {a}. Real a => a -> Double
toMilliseconds
where
toMilliseconds :: a -> Double
toMilliseconds = (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000) (Double -> Double) -> (a -> Double) -> a -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac @_ @Double
histogramSinceBy
:: ( MonadUnliftIO m
, MonadReader env m
, HasStatsClient env
, Datadog.ToMetricValue n
)
=> (NominalDiffTime -> n)
-> Text
-> UTCTime
-> m ()
histogramSinceBy :: forall (m :: * -> *) env n.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env,
ToMetricValue n) =>
(NominalDiffTime -> n) -> Text -> UTCTime -> m ()
histogramSinceBy NominalDiffTime -> n
f Text
name UTCTime
time = do
UTCTime
now <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
let delta :: n
delta = NominalDiffTime -> n
f (NominalDiffTime -> n) -> NominalDiffTime -> n
forall a b. (a -> b) -> a -> b
$ UTCTime
now UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
time
MetricType -> Text -> n -> m ()
forall (m :: * -> *) env v.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env,
ToMetricValue v) =>
MetricType -> Text -> v -> m ()
sendMetric MetricType
Datadog.Histogram Text
name n
delta
sendMetric
:: ( MonadUnliftIO m
, MonadReader env m
, HasStatsClient env
, Datadog.ToMetricValue v
)
=> Datadog.MetricType
-> Text
-> v
-> m ()
sendMetric :: forall (m :: * -> *) env v.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env,
ToMetricValue v) =>
MetricType -> Text -> v -> m ()
sendMetric MetricType
metricType Text
name v
metricValue = do
StatsClient {[(Text, Text)]
StatsClient
Gauges
scClient :: StatsClient -> StatsClient
scTags :: StatsClient -> [(Text, Text)]
scGauges :: StatsClient -> Gauges
scClient :: StatsClient
scTags :: [(Text, Text)]
scGauges :: Gauges
..} <- Getting StatsClient env StatsClient -> m StatsClient
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting StatsClient env StatsClient
forall env. HasStatsClient env => Lens' env StatsClient
Lens' env StatsClient
statsClientL
StatsClient -> Metric -> m ()
forall (m :: * -> *) v.
(MonadIO m, ToStatsD v) =>
StatsClient -> v -> m ()
Datadog.send StatsClient
scClient (Metric -> m ()) -> Metric -> m ()
forall a b. (a -> b) -> a -> b
$
MetricName -> MetricType -> v -> Metric
forall a.
ToMetricValue a =>
MetricName -> MetricType -> a -> Metric
Datadog.metric (Text -> MetricName
Datadog.MetricName Text
name) MetricType
metricType v
metricValue
Metric -> (Metric -> Metric) -> Metric
forall a b. a -> (a -> b) -> b
& (([Tag] -> Identity [Tag]) -> Metric -> Identity Metric
forall s a. HasTags s a => Lens' s a
Lens' Metric [Tag]
Datadog.tags (([Tag] -> Identity [Tag]) -> Metric -> Identity Metric)
-> [Tag] -> Metric -> Metric
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((Text, Text) -> Tag) -> [(Text, Text)] -> [Tag]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Tag) -> (Text, Text) -> Tag
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Tag
Datadog.tag) [(Text, Text)]
scTags)
getEcsMetadataTags :: MonadIO m => m [(Text, Text)]
getEcsMetadataTags :: forall (m :: * -> *). MonadIO m => m [(Text, Text)]
getEcsMetadataTags = do
Either EcsMetadataError EcsMetadata
eMetadata <- ExceptT EcsMetadataError m EcsMetadata
-> m (Either EcsMetadataError EcsMetadata)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT EcsMetadataError m EcsMetadata
forall (m :: * -> *).
(MonadIO m, MonadError EcsMetadataError m) =>
m EcsMetadata
getEcsMetadata
(EcsMetadataError -> m [(Text, Text)])
-> (EcsMetadata -> m [(Text, Text)])
-> Either EcsMetadataError EcsMetadata
-> m [(Text, Text)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (([] [(Text, Text)] -> m () -> m [(Text, Text)]
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (m () -> m [(Text, Text)])
-> (EcsMetadataError -> m ())
-> EcsMetadataError
-> m [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EcsMetadataError -> m ()
forall {m :: * -> *} {a}. (MonadIO m, Show a) => a -> m ()
err) ([(Text, Text)] -> m [(Text, Text)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, Text)] -> m [(Text, Text)])
-> (EcsMetadata -> [(Text, Text)])
-> EcsMetadata
-> m [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EcsMetadata -> [(Text, Text)]
forall {a}. IsString a => EcsMetadata -> [(a, Text)]
toTags) Either EcsMetadataError EcsMetadata
eMetadata
where
err :: a -> m ()
err a
e = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> HostName -> IO ()
hPutStrLn Handle
stderr (HostName -> IO ()) -> HostName -> IO ()
forall a b. (a -> b) -> a -> b
$ HostName
"Error reading ECS Metadata: " HostName -> HostName -> HostName
forall a. Semigroup a => a -> a -> a
<> a -> HostName
forall a. Show a => a -> HostName
show a
e
toTags :: EcsMetadata -> [(a, Text)]
toTags (EcsMetadata EcsContainerMetadata {Text
ecmDockerId :: Text
ecmDockerName :: Text
ecmImage :: Text
ecmImageID :: Text
ecmDockerId :: EcsContainerMetadata -> Text
ecmDockerName :: EcsContainerMetadata -> Text
ecmImage :: EcsContainerMetadata -> Text
ecmImageID :: EcsContainerMetadata -> Text
..} EcsContainerTaskMetadata {Text
ectmCluster :: Text
ectmTaskARN :: Text
ectmFamily :: Text
ectmRevision :: Text
ectmCluster :: EcsContainerTaskMetadata -> Text
ectmTaskARN :: EcsContainerTaskMetadata -> Text
ectmFamily :: EcsContainerTaskMetadata -> Text
ectmRevision :: EcsContainerTaskMetadata -> Text
..}) =
[ (a
"container_id", Text
ecmDockerId)
, (a
"container_name", Text
ecmDockerName)
, (a
"docker_image", Text
ecmImage)
, (a
"image_tag", Text
ecmImageID)
, (a
"cluster_name", Text
ectmCluster)
, (a
"task_arn", Text
ectmTaskARN)
, (a
"task_family", Text
ectmFamily)
, (a
"task_version", Text
ectmRevision)
]