{-# LANGUAGE TupleSections #-}

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

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

  -- * Gauges
  , Gauges
  , Gauge
  , dbConnections
  , withGauge

  -- * 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 :: [(Text, Text)]
amsTags = [(Text, Text)]
x }

envParseStatsSettings :: Env.Parser Env.Error StatsSettings
envParseStatsSettings :: Parser Error StatsSettings
envParseStatsSettings =
  Bool -> DogStatsSettings -> [(Text, Text)] -> StatsSettings
StatsSettings
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. HostName -> Mod Flag Bool -> Parser e Bool
Env.switch HostName
"DOGSTATSD_ENABLED" forall a. Monoid a => a
mempty
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe HostName -> Maybe Int -> DogStatsSettings
buildSettings
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e a.
AsUnset e =>
Reader e a -> HostName -> Mod Var a -> Parser e a
Env.var forall s e. IsString s => Reader e s
Env.str HostName
"DOGSTATSD_HOST" forall a. Monoid a => a
mempty)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e a.
AsUnset e =>
Reader e a -> HostName -> Mod Var a -> Parser e a
Env.var forall e a. (AsUnread e, Read a) => Reader e a
Env.auto HostName
"DOGSTATSD_PORT" forall a. Monoid a => a
mempty)
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall {t} {a}.
IsString t =>
Maybe a -> Maybe a -> Maybe a -> [(t, a)] -> [(t, a)]
buildTags
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e a.
AsUnset e =>
Reader e a -> HostName -> Mod Var a -> Parser e a
Env.var forall e s. (AsEmpty e, IsString s) => Reader e s
Env.nonempty HostName
"DD_ENV" forall a. Monoid a => a
mempty)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e a.
AsUnset e =>
Reader e a -> HostName -> Mod Var a -> Parser e a
Env.var forall e s. (AsEmpty e, IsString s) => Reader e s
Env.nonempty HostName
"DD_SERVICE" forall a. Monoid a => a
mempty)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e a.
AsUnset e =>
Reader e a -> HostName -> Mod Var a -> Parser e a
Env.var forall e s. (AsEmpty e, IsString s) => Reader e s
Env.nonempty HostName
"DD_VERSION" forall a. Monoid a => a
mempty)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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" (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
      forall a b. a -> (a -> b) -> b
& forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall s a. HasHost s a => Lens' s a
Datadog.host forall s t a b. ASetter s t a b -> b -> s -> t
.~) Maybe HostName
mHost
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall s a. HasPort s a => Lens' s a
Datadog.port 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 =
    forall a. [Maybe a] -> [a]
catMaybes
        [ (t
"env", ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mEnv
        , (t
"environment", ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mEnv -- Legacy
        , (t
"service", ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mService
        , (t
"version", ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mVersion
        ]
      forall a. Semigroup a => a -> a -> a
<> [(t, a)]
tags

newtype Gauges = Gauges
  { Gauges -> Gauge
gdbConnections :: Gauge
  -- ^ Track open db connections
  }

data Gauge = Gauge
  { Gauge -> Text
gName :: Text
  , Gauge -> Gauge
gGauge :: EKG.Gauge
  }

dbConnections :: Gauges -> Gauge
dbConnections :: Gauges -> Gauge
dbConnections = Gauges -> Gauge
gdbConnections

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 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens StatsClient -> [(Text, Text)]
scTags forall a b. (a -> b) -> a -> b
$ \StatsClient
x [(Text, Text)]
y -> StatsClient
x { scTags :: [(Text, Text)]
scTags = [(Text, Text)]
y }

gaugesL :: Lens' StatsClient Gauges
gaugesL :: Lens' StatsClient Gauges
gaugesL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens StatsClient -> Gauges
scGauges forall a b. (a -> b) -> a -> b
$ \StatsClient
x Gauges
y -> StatsClient
x { scGauges :: Gauges
scGauges = Gauges
y }

class HasStatsClient env where
  statsClientL :: Lens' env StatsClient

instance HasStatsClient StatsClient where
  statsClientL :: Lens' StatsClient StatsClient
statsClientL = forall a. a -> a
id

instance HasStatsClient site =>  HasStatsClient (HandlerData child site) where
  statsClientL :: Lens' (HandlerData child site) StatsClient
statsClientL = forall child site.
Lens' (HandlerData child site) (RunHandlerEnv child site)
envL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall child site. Lens' (RunHandlerEnv child site) site
siteL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. HasStatsClient env => Lens' env 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
amsTags :: [(Text, Text)]
amsSettings :: DogStatsSettings
amsEnabled :: Bool
amsTags :: StatsSettings -> [(Text, Text)]
amsSettings :: StatsSettings -> DogStatsSettings
amsEnabled :: StatsSettings -> Bool
..} StatsClient -> m a
f = do
  Gauges
gauges <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Gauge
gdbConnections <- Text -> Gauge -> Gauge
Gauge Text
"active_pool_connections" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Gauge
EKG.new
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Gauges { Gauge
gdbConnections :: Gauge
gdbConnections :: Gauge
.. }

  if Bool
amsEnabled
    then do
      [(Text, Text)]
tags <- ([(Text, Text)]
amsTags forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => m [(Text, Text)]
getEcsMetadataTags
      forall (m :: * -> *) a.
MonadUnliftIO m =>
DogStatsSettings -> (StatsClient -> m a) -> m a
Datadog.withDogStatsD DogStatsSettings
amsSettings forall a b. (a -> b) -> a -> b
$ \StatsClient
client ->
        -- Add the tags to the thread context so they're present in all logs
        forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Pair] -> m a -> m a
withThreadContext (forall a b. (a -> b) -> [a] -> [b]
map forall {p :: * -> * -> *} {b}.
(Bifunctor p, IsString b) =>
p Text Text -> p b Value
toPair [(Text, Text)]
tags) 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 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 = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a. IsString a => HostName -> a
fromString 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' <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasStatsClient env => Lens' env StatsClient
statsClientL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' StatsClient Gauges
gaugesL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Gauges -> Gauge
getGauge
  forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracket_ (forall {m :: * -> *} {env}.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Gauge -> m ()
inc Gauge
gauge') (forall {m :: * -> *} {env}.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Gauge -> m ()
dec Gauge
gauge') m a
f
 where
  inc :: Gauge -> m ()
inc g :: Gauge
g@Gauge {Text
Gauge
gGauge :: Gauge
gName :: Text
gGauge :: Gauge -> Gauge
gName :: Gauge -> Text
..} = do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Gauge -> IO ()
EKG.inc Gauge
gGauge
    forall {m :: * -> *} {env}.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Gauge -> m ()
publish Gauge
g

  dec :: Gauge -> m ()
dec g :: Gauge
g@Gauge {Text
Gauge
gGauge :: Gauge
gName :: Text
gGauge :: Gauge -> Gauge
gName :: Gauge -> Text
..} = do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Gauge -> IO ()
EKG.dec Gauge
gGauge
    forall {m :: * -> *} {env}.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Gauge -> m ()
publish Gauge
g

  publish :: Gauge -> m ()
publish Gauge {Text
Gauge
gGauge :: Gauge
gName :: Text
gGauge :: Gauge -> Gauge
gName :: Gauge -> Text
..} = do
    Int64
n <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Gauge -> IO Int64
EKG.read Gauge
gGauge
    forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> Double -> m ()
gauge Text
gName forall a b. (a -> b) -> a -> b
$ 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 = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local forall a b. (a -> b) -> a -> b
$ forall env. HasStatsClient env => Lens' env StatsClient
statsClientL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' StatsClient [(Text, Text)]
tagsL 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 = 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 = 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 = 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 = 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 = forall (m :: * -> *) env n.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env,
 ToMetricValue n) =>
(NominalDiffTime -> n) -> Text -> UTCTime -> m ()
histogramSinceBy 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 = forall (m :: * -> *) env n.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env,
 ToMetricValue n) =>
(NominalDiffTime -> n) -> Text -> UTCTime -> m ()
histogramSinceBy forall {a}. Real a => a -> Double
toMilliseconds
  where toMilliseconds :: a -> Double
toMilliseconds = (forall a. Num a => a -> a -> a
* Double
1000) 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let delta :: n
delta = NominalDiffTime -> n
f forall a b. (a -> b) -> a -> b
$ UTCTime
now UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
time
  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
scGauges :: Gauges
scTags :: [(Text, Text)]
scClient :: StatsClient
scGauges :: StatsClient -> Gauges
scTags :: StatsClient -> [(Text, Text)]
scClient :: StatsClient -> StatsClient
..} <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasStatsClient env => Lens' env StatsClient
statsClientL

  forall (m :: * -> *) v.
(MonadIO m, ToStatsD v) =>
StatsClient -> v -> m ()
Datadog.send StatsClient
scClient
    forall a b. (a -> b) -> a -> b
$ forall a.
ToMetricValue a =>
MetricName -> MetricType -> a -> Metric
Datadog.metric (Text -> MetricName
Datadog.MetricName Text
name) MetricType
metricType v
metricValue
    forall a b. a -> (a -> b) -> b
& (forall s a. HasTags s a => Lens' s a
Datadog.tags forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a b. (a -> b) -> [a] -> [b]
map (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 <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall (m :: * -> *).
(MonadIO m, MonadError EcsMetadataError m) =>
m EcsMetadata
getEcsMetadata
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (([] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *} {a}. (MonadIO m, Show a) => a -> m ()
err) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. IsString a => EcsMetadata -> [(a, Text)]
toTags) Either EcsMetadataError EcsMetadata
eMetadata
 where
  err :: a -> m ()
err a
e = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> HostName -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ HostName
"Error reading ECS Metadata: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> HostName
show a
e

  toTags :: EcsMetadata -> [(a, Text)]
toTags (EcsMetadata EcsContainerMetadata {Text
ecmImageID :: EcsContainerMetadata -> Text
ecmImage :: EcsContainerMetadata -> Text
ecmDockerName :: EcsContainerMetadata -> Text
ecmDockerId :: EcsContainerMetadata -> Text
ecmImageID :: Text
ecmImage :: Text
ecmDockerName :: Text
ecmDockerId :: Text
..} EcsContainerTaskMetadata {Text
ectmRevision :: EcsContainerTaskMetadata -> Text
ectmFamily :: EcsContainerTaskMetadata -> Text
ectmTaskARN :: EcsContainerTaskMetadata -> Text
ectmCluster :: EcsContainerTaskMetadata -> Text
ectmRevision :: Text
ectmFamily :: Text
ectmTaskARN :: Text
ectmCluster :: 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)
      ]

-- $usage
-- 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\"
--         -- ...
--   @
--