{-# LANGUAGE TupleSections #-}

-- | An intentionally-leaky StatsD interface to Datadog
module Freckle.App.Stats
  ( -- $docs
    StatsSettings
  , defaultStatsSettings
  , setStatsSettingsTags
  , envParseStatsSettings

    -- * Client
  , StatsClient
  , tagsL
  , withStatsClient
  , HasStatsClient (..)

    -- * Gauges
  , Gauges
  , Gauge
  , dbConnections
  , dbEnqueuedAndProcessing
  , withGauge
  , lookupGauge
  , incGauge
  , decGauge

    -- * Reporting
  , 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 -- Legacy
      , (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
  -- ^ Track open db connections
  , Gauges -> Gauge
gdbEnqueuedAndProcessing :: Gauge
  -- ^ Track enqueued and processing queries
  }

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 ->
        -- Add the tags to the thread context so they're present in all logs
        [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

-- | Include the given tags on all metrics emitted from a block
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

-- | Synonym for @'counter' 1@
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

-- | Emit an elapsed duration (which Datadog calls a /histogram/)
--
-- The 'ToMetricValue' constraint can be satisfied by most numeric types and is
-- assumed to be seconds.
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)
    ]

-- $docs
--
-- == Usage
--
-- - Use 'envParseStatsSettings' to configure things
--
--   @
--   data AppSettings = AppSettings
--    { -- ...
--    , appStatsSettings :: StatsSettings
--    }
--
--   loadSettings :: IO AppSettings
--   loadSettings = Env.parse id $ AppSettings
--     <$> -- ...
--     <*> 'envParseStatsSettings'
--   @
--
--   This will read,
--
--   - @DOGSTATSD_ENABLED=x@
--   - @DOGSTATSD_HOST=127.0.0.1@
--   - @DOGSTATSD_PORT=8125@
--   - @DOGSTATSD_TAGS=[<key>:<value>,...]@
--   - Optionally @DD_ENV@, @DD_SERVICE@, and @DD_VERSION@
--
-- - Give your @App@ a 'HasStatsClient' instance
--
--   @
--   data App = App
--     { -- ...
--     , appStatsClient :: 'StatsClient'
--     }
--
--   instance 'HasStatsClient' App where
--     'statsClientL' = lens appStatsClient $ \x y -> { appStatsClient = y }
--   @
--
-- - Use 'withStatsClient' to build and store a client on your @App@ when you
--   run it
--
--   @
--   'withStatsClient' appStatsSettings $ \client -> do
--     app <- App
--       <$> ...
--       <*> pure client
--
--     'runApp' app $ ...
--   @
--
-- - Throughout your application code, emit metrics as desired
--
--   @
--   import qualified Freckle.App.Stats as Stats
--
--   myFunction :: (MonadIO m, MonadReader env m, 'HasStatsClient' env) => m ()
--   myFunction = do
--     start <- liftIO getCurrentTime
--     result <- myAction
--
--     Stats.'increment' \"action.attempt\"
--     Stats.'histogramSinceMs' \"action.duration\" start
--
--     case result of
--       Left err -> do
--         Stats.'increment' \"action.failure\"
--         -- ...
--       Right x -. do
--         Stats.'increment' \"action.success\"
--         -- ...
--   @