{-| DogStatsD accepts custom application metrics points over UDP, and then periodically aggregates and forwards the metrics to Datadog, where they can be graphed on dashboards. The data is sent by using a client library such as this one that communicates with a DogStatsD server. -}

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Network.StatsD.Datadog (
  -- * Client interface
  DogStatsSettings(..),
  defaultSettings,
  withDogStatsD,
  mkStatsClient,
  finalizeStatsClient,
  send,
  -- * Data supported by DogStatsD
  metric,
  Metric,
  MetricName(..),
  MetricType(..),
  event,
  Event,
  serviceCheck,
  ServiceCheck,
  ServiceCheckStatus(..),
  ToStatsD,
  -- * Optional fields
  Tag(fromTag),
  tag,
  ToMetricValue(..),
  value,
  Priority(..),
  AlertType(..),
  HasName(..),
  HasSampleRate(..),
  HasType'(..),
  HasTags(..),
  HasTitle(..),
  HasText(..),
  HasDateHappened(..),
  HasHostname(..),
  HasAggregationKey(..),
  HasPriority(..),
  HasSourceTypeName(..),
  HasAlertType(..),
  HasHost(..),
  HasPort(..),
  HasBufferSize(..),
  HasMaxDelay(..),
  HasOnException(..),
  HasStatus(..),
  HasMessage(..),
  -- * Dummy client
  StatsClient(Dummy)
) where
import Control.Applicative ((<$>))
import Control.Exception (SomeException)
import Control.Lens
import Control.Monad (void)
import Control.Reaper
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L
import Data.BufferBuilder.Utf8
import Data.Function (on)
import Data.List (intersperse)
import qualified Data.Sequence as Seq
import qualified Data.ByteString as B
import qualified Data.Foldable as F
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Network.Socket hiding (send, sendTo, recv, recvFrom)
import System.IO
  ( BufferMode(BlockBuffering)
  , Handle
  , IOMode(WriteMode)
  )
import UnliftIO

epochTime :: UTCTime -> Int
epochTime :: UTCTime -> Int
epochTime = POSIXTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int) -> (UTCTime -> POSIXTime) -> UTCTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds

newtype MetricName = MetricName { MetricName -> Text
fromMetricName :: Text }

cleanMetricText :: Text -> Text
cleanMetricText :: Text -> Text
cleanMetricText = (Char -> Char) -> Text -> Text
T.map ((Char -> Char) -> Text -> Text) -> (Char -> Char) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
c -> case Char
c of
  Char
':' -> Char
'_'
  Char
'|' -> Char
'_'
  Char
'@' -> Char
'_'
  Char
_   -> Char
c
{-# INLINE cleanMetricText #-}

escapeEventContents :: T.Text -> T.Text
escapeEventContents :: Text -> Text
escapeEventContents = Text -> Text -> Text -> Text
T.replace Text
"\n" Text
"\\n"
{-# INLINE escapeEventContents #-}

-- | Tags are a Datadog specific extension to StatsD. They allow you to tag a metric with a
-- dimension that’s meaningful to you and slice and dice along that dimension in your graphs.
-- For example, if you wanted to measure the performance of two video rendering algorithms,
-- you could tag the rendering time metric with the version of the algorithm you used.
newtype Tag = Tag { Tag -> Utf8Builder ()
fromTag :: Utf8Builder () }

instance Show Tag where show :: Tag -> String
show = (String
"Tag " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Tag -> String) -> Tag -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Tag -> Text) -> Tag -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Tag -> ByteString) -> Tag -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder () -> ByteString
runUtf8Builder (Utf8Builder () -> ByteString)
-> (Tag -> Utf8Builder ()) -> Tag -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Utf8Builder ()
fromTag
instance Eq Tag where == :: Tag -> Tag -> Bool
(==) = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool) -> (Tag -> String) -> Tag -> Tag -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Tag -> String
forall a. Show a => a -> String
show

-- | Create a tag from a key-value pair. Useful for slicing and dicing events in Datadog.
--
-- Key and value text values are normalized by converting ":"s, "|"s, and "@"s to underscores ("_").
tag :: Text -> Text -> Tag
tag :: Text -> Text -> Tag
tag Text
k Text
v = Utf8Builder () -> Tag
Tag (Text -> Utf8Builder ()
build Text
k Utf8Builder () -> Utf8Builder () -> Utf8Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Utf8Builder ()
appendChar7 Char
':' Utf8Builder () -> Utf8Builder () -> Utf8Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Utf8Builder ()
build Text
v)
  where
    build :: Text -> Utf8Builder ()
build = Text -> Utf8Builder ()
appendText (Text -> Utf8Builder ())
-> (Text -> Text) -> Text -> Utf8Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
cleanMetricText

data MetricType = Gauge      -- ^ Gauges measure the value of a particular thing at a particular time, like the amount of fuel in a car’s gas tank or the number of users connected to a system.
                | Counter    -- ^ Counters track how many times something happened per second, like the number of database requests or page views.
                | Timer      -- ^ StatsD only supports histograms for timing, not generic values (like the size of uploaded files or the number of rows returned from a query). Timers are essentially a special case of histograms, so they are treated in the same manner by DogStatsD for backwards compatibility.
                | Histogram  -- ^ Histograms track the statistical distribution of a set of values, like the duration of a number of database queries or the size of files uploaded by users. Each histogram will track the average, the minimum, the maximum, the median and the 95th percentile.
                | Set        -- ^ Sets are used to count the number of unique elements in a group. If you want to track the number of unique visitor to your site, sets are a great way to do that.

-- | Converts a supported numeric type to the format understood by DogStatsD. Currently limited by BufferBuilder encoding options.
class ToMetricValue a where
  encodeValue :: a -> Utf8Builder ()

instance ToMetricValue Int where
  encodeValue :: Int -> Utf8Builder ()
encodeValue = Int -> Utf8Builder ()
appendDecimalSignedInt

instance ToMetricValue Double where
  encodeValue :: Double -> Utf8Builder ()
encodeValue = Double -> Utf8Builder ()
appendDecimalDouble

-- | Smart 'Metric' constructor. Use the lens functions to set the optional fields.
metric :: (ToMetricValue a) => MetricName -> MetricType -> a -> Metric
metric :: MetricName -> MetricType -> a -> Metric
metric MetricName
n MetricType
t a
v = MetricName
-> Double -> MetricType -> Utf8Builder () -> [Tag] -> Metric
Metric MetricName
n Double
1 MetricType
t (a -> Utf8Builder ()
forall a. ToMetricValue a => a -> Utf8Builder ()
encodeValue a
v) []

-- | 'Metric'
--
-- The fields accessible through corresponding lenses are:
--
-- * 'name' @::@ 'MetricName'
--
-- * 'sampleRate' @::@ 'Double'
--
-- * 'type'' @::@ 'MetricType'
--
-- * 'value' @::@ 'ToMetricValue' @a => a@
--
-- * 'tags' @::@ @[@'Tag'@]@
data Metric = Metric
  { Metric -> MetricName
metricName       :: !MetricName
  , Metric -> Double
metricSampleRate :: {-# UNPACK #-} !Double
  , Metric -> MetricType
metricType'      :: !MetricType
  , Metric -> Utf8Builder ()
mValue           :: !(Utf8Builder ())
  , Metric -> [Tag]
metricTags       :: ![Tag]
  }

makeFields ''Metric

-- | Special setter to update the value of a 'Metric'.
--
-- > metric ("foo"" :: Text) Counter (1 :: Int) & value .~ (5 :: Double)
value :: ToMetricValue a => Setter Metric Metric (Utf8Builder ()) a
value :: Setter Metric Metric (Utf8Builder ()) a
value = ((Utf8Builder () -> a) -> Metric -> Metric)
-> Optical (->) (->) f Metric Metric (Utf8Builder ()) a
forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
sets (((Utf8Builder () -> a) -> Metric -> Metric)
 -> Optical (->) (->) f Metric Metric (Utf8Builder ()) a)
-> ((Utf8Builder () -> a) -> Metric -> Metric)
-> Optical (->) (->) f Metric Metric (Utf8Builder ()) a
forall a b. (a -> b) -> a -> b
$ \Utf8Builder () -> a
f Metric
m -> Metric
m { mValue :: Utf8Builder ()
mValue = a -> Utf8Builder ()
forall a. ToMetricValue a => a -> Utf8Builder ()
encodeValue (a -> Utf8Builder ()) -> a -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder () -> a
f (Utf8Builder () -> a) -> Utf8Builder () -> a
forall a b. (a -> b) -> a -> b
$ Metric -> Utf8Builder ()
mValue Metric
m }
{-# INLINE value #-}

renderMetric :: Metric -> Utf8Builder ()
renderMetric :: Metric -> Utf8Builder ()
renderMetric (Metric MetricName
n Double
sr MetricType
t Utf8Builder ()
v [Tag]
ts) = do
  Text -> Utf8Builder ()
appendText (Text -> Utf8Builder ()) -> Text -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cleanMetricText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ MetricName -> Text
fromMetricName MetricName
n
  Char -> Utf8Builder ()
appendChar7 Char
':'
  Utf8Builder ()
v
  Char -> Utf8Builder ()
appendChar7 Char
'|'
  Utf8Builder ()
unit
  Utf8Builder ()
formatRate
  Utf8Builder ()
formatTags
  where
    unit :: Utf8Builder ()
unit = case MetricType
t of
      MetricType
Gauge     -> Char -> Utf8Builder ()
appendChar7 Char
'g'
      MetricType
Counter   -> Char -> Utf8Builder ()
appendChar7 Char
'c'
      MetricType
Timer     -> ByteString -> Utf8Builder ()
appendBS7 ByteString
"ms"
      MetricType
Histogram -> Char -> Utf8Builder ()
appendChar7 Char
'h'
      MetricType
Set       -> Char -> Utf8Builder ()
appendChar7 Char
's'
    formatTags :: Utf8Builder ()
formatTags = case [Tag]
ts of
      [] -> () -> Utf8Builder ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [Tag]
xs -> ByteString -> Utf8Builder ()
appendBS7 ByteString
"|#" Utf8Builder () -> Utf8Builder () -> Utf8Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Utf8Builder ()] -> Utf8Builder ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
F.sequence_ (Utf8Builder () -> [Utf8Builder ()] -> [Utf8Builder ()]
forall a. a -> [a] -> [a]
intersperse (Char -> Utf8Builder ()
appendChar7 Char
',') ([Utf8Builder ()] -> [Utf8Builder ()])
-> [Utf8Builder ()] -> [Utf8Builder ()]
forall a b. (a -> b) -> a -> b
$ (Tag -> Utf8Builder ()) -> [Tag] -> [Utf8Builder ()]
forall a b. (a -> b) -> [a] -> [b]
map Tag -> Utf8Builder ()
fromTag [Tag]
xs)
    formatRate :: Utf8Builder ()
formatRate = if Double
sr Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
1 then () -> Utf8Builder ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else ByteString -> Utf8Builder ()
appendBS7 ByteString
"|@" Utf8Builder () -> Utf8Builder () -> Utf8Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Utf8Builder ()
appendDecimalDouble Double
sr

data Priority = Low | Normal
data AlertType = Error | Warning | Info | Success

-- | Smart 'Event' constructor. Use the lens functions to set the optional fields.
event :: Text -> Text -> Event
event :: Text -> Text -> Event
event Text
t Text
d = Text
-> Text
-> Maybe UTCTime
-> Maybe Text
-> Maybe Text
-> Maybe Priority
-> Maybe Text
-> Maybe AlertType
-> [Tag]
-> Event
Event Text
t Text
d Maybe UTCTime
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Priority
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe AlertType
forall a. Maybe a
Nothing []

-- | 'Event'
--
-- The fields accessible through corresponding lenses are:
--
-- * 'title' @::@ 'Text'
--
-- * 'text' @::@ 'Text'
--
-- * 'dateHappened' @::@ 'Maybe' 'UTCTime'
--
-- * 'hostname' @::@ 'Maybe' 'Text'
--
-- * 'aggregationKey' @::@ 'Maybe' 'Text'
--
-- * 'priority' @::@ 'Maybe' 'Priority'
--
-- * 'sourceTypeName' @::@ 'Maybe' 'Text'
--
-- * 'alertType' @::@ 'Maybe' 'AlertType'
--
-- * 'tags' @::@ @[@'Tag'@]@
--
data Event = Event
  { Event -> Text
eventTitle          :: {-# UNPACK #-} !Text
  , Event -> Text
eventText           :: {-# UNPACK #-} !Text
  , Event -> Maybe UTCTime
eventDateHappened   :: !(Maybe UTCTime)
  , Event -> Maybe Text
eventHostname       :: !(Maybe Text)
  , Event -> Maybe Text
eventAggregationKey :: !(Maybe Text)
  , Event -> Maybe Priority
eventPriority       :: !(Maybe Priority)
  , Event -> Maybe Text
eventSourceTypeName :: !(Maybe Text)
  , Event -> Maybe AlertType
eventAlertType      :: !(Maybe AlertType)
  , Event -> [Tag]
eventTags           :: ![Tag]
  }

makeFields ''Event

renderEvent :: Event -> Utf8Builder ()
renderEvent :: Event -> Utf8Builder ()
renderEvent Event
e = do
  ByteString -> Utf8Builder ()
appendBS7 ByteString
"_e{"
  Int -> Utf8Builder ()
forall a. ToMetricValue a => a -> Utf8Builder ()
encodeValue (Int -> Utf8Builder ()) -> Int -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
escapedTitle
  Char -> Utf8Builder ()
appendChar7 Char
','
  Int -> Utf8Builder ()
forall a. ToMetricValue a => a -> Utf8Builder ()
encodeValue (Int -> Utf8Builder ()) -> Int -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
escapedText
  ByteString -> Utf8Builder ()
appendBS7 ByteString
"}:"
  -- This is safe because we encodeUtf8 below
  -- We do so to get the length of the ultimately encoded bytes for the datagram format
  ByteString -> Utf8Builder ()
unsafeAppendBS ByteString
escapedTitle
  Char -> Utf8Builder ()
appendChar7 Char
'|'
  -- This is safe because we encodeUtf8 below
  -- We do so to get the length of the ultimately encoded bytes for the datagram format
  ByteString -> Utf8Builder ()
unsafeAppendBS ByteString
escapedText
  Utf8Builder ()
happened
  Utf8Builder ()
formatHostname
  Utf8Builder ()
aggregation
  Utf8Builder ()
formatPriority
  Utf8Builder ()
sourceType
  Utf8Builder ()
alert
  Utf8Builder ()
formatTags
  where
    escapedTitle :: ByteString
escapedTitle = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeEventContents (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Event -> Text
eventTitle Event
e
    escapedText :: ByteString
escapedText = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeEventContents (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Event -> Text
eventText Event
e
    makeField :: Char -> t (Utf8Builder b) -> Utf8Builder ()
makeField Char
c t (Utf8Builder b)
v = t (Utf8Builder b)
-> (Utf8Builder b -> Utf8Builder b) -> Utf8Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ t (Utf8Builder b)
v ((Utf8Builder b -> Utf8Builder b) -> Utf8Builder ())
-> (Utf8Builder b -> Utf8Builder b) -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ \Utf8Builder b
jv ->
      Char -> Utf8Builder ()
appendChar7 Char
'|' Utf8Builder () -> Utf8Builder () -> Utf8Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Utf8Builder ()
appendChar7 Char
c Utf8Builder () -> Utf8Builder () -> Utf8Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Utf8Builder ()
appendChar7 Char
':' Utf8Builder () -> Utf8Builder b -> Utf8Builder b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Utf8Builder b
jv
    cleanTextValue :: (Event -> Maybe Text) -> Maybe (Utf8Builder ())
cleanTextValue Event -> Maybe Text
f = (Text -> Utf8Builder ()
appendText (Text -> Utf8Builder ())
-> (Text -> Text) -> Text -> Utf8Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
cleanMetricText) (Text -> Utf8Builder ()) -> Maybe Text -> Maybe (Utf8Builder ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event -> Maybe Text
f Event
e
    -- TODO figure out the actual format that dateHappened values are supposed to have.
    happened :: Utf8Builder ()
happened = Maybe UTCTime -> (UTCTime -> Utf8Builder ()) -> Utf8Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ (Event -> Maybe UTCTime
eventDateHappened Event
e) ((UTCTime -> Utf8Builder ()) -> Utf8Builder ())
-> (UTCTime -> Utf8Builder ()) -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ \UTCTime
h -> do
      ByteString -> Utf8Builder ()
appendBS7 ByteString
"|d:"
      Int -> Utf8Builder ()
appendDecimalSignedInt (Int -> Utf8Builder ()) -> Int -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> Int
epochTime UTCTime
h
    formatHostname :: Utf8Builder ()
formatHostname = Char -> Maybe (Utf8Builder ()) -> Utf8Builder ()
forall (t :: * -> *) b.
Foldable t =>
Char -> t (Utf8Builder b) -> Utf8Builder ()
makeField Char
'h' (Maybe (Utf8Builder ()) -> Utf8Builder ())
-> Maybe (Utf8Builder ()) -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ (Event -> Maybe Text) -> Maybe (Utf8Builder ())
cleanTextValue Event -> Maybe Text
eventHostname
    aggregation :: Utf8Builder ()
aggregation = Char -> Maybe (Utf8Builder ()) -> Utf8Builder ()
forall (t :: * -> *) b.
Foldable t =>
Char -> t (Utf8Builder b) -> Utf8Builder ()
makeField Char
'k' (Maybe (Utf8Builder ()) -> Utf8Builder ())
-> Maybe (Utf8Builder ()) -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ (Event -> Maybe Text) -> Maybe (Utf8Builder ())
cleanTextValue Event -> Maybe Text
eventAggregationKey
    formatPriority :: Utf8Builder ()
formatPriority = Maybe Priority -> (Priority -> Utf8Builder ()) -> Utf8Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ (Event -> Maybe Priority
eventPriority Event
e) ((Priority -> Utf8Builder ()) -> Utf8Builder ())
-> (Priority -> Utf8Builder ()) -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ \Priority
p -> do
      ByteString -> Utf8Builder ()
appendBS7 ByteString
"|p:"
      ByteString -> Utf8Builder ()
appendBS7 (ByteString -> Utf8Builder ()) -> ByteString -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ case Priority
p of
        Priority
Low    -> ByteString
"low"
        Priority
Normal -> ByteString
"normal"
    sourceType :: Utf8Builder ()
sourceType = Char -> Maybe (Utf8Builder ()) -> Utf8Builder ()
forall (t :: * -> *) b.
Foldable t =>
Char -> t (Utf8Builder b) -> Utf8Builder ()
makeField Char
's' (Maybe (Utf8Builder ()) -> Utf8Builder ())
-> Maybe (Utf8Builder ()) -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ (Event -> Maybe Text) -> Maybe (Utf8Builder ())
cleanTextValue Event -> Maybe Text
eventSourceTypeName
    alert :: Utf8Builder ()
alert = Maybe AlertType -> (AlertType -> Utf8Builder ()) -> Utf8Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ (Event -> Maybe AlertType
eventAlertType Event
e) ((AlertType -> Utf8Builder ()) -> Utf8Builder ())
-> (AlertType -> Utf8Builder ()) -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ \AlertType
a -> do
              ByteString -> Utf8Builder ()
appendBS7 ByteString
"|t:"
              ByteString -> Utf8Builder ()
appendBS7 (ByteString -> Utf8Builder ()) -> ByteString -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ case AlertType
a of
                AlertType
Error   -> ByteString
"error"
                AlertType
Warning -> ByteString
"warning"
                AlertType
Info    -> ByteString
"info"
                AlertType
Success -> ByteString
"success"
    formatTags :: Utf8Builder ()
formatTags = case Event -> [Tag]
eventTags Event
e of
      [] -> () -> Utf8Builder ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [Tag]
ts -> do
        ByteString -> Utf8Builder ()
appendBS7 ByteString
"|#"
        [Utf8Builder ()] -> Utf8Builder ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Utf8Builder ()] -> Utf8Builder ())
-> [Utf8Builder ()] -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder () -> [Utf8Builder ()] -> [Utf8Builder ()]
forall a. a -> [a] -> [a]
intersperse (Char -> Utf8Builder ()
appendChar7 Char
',') ([Utf8Builder ()] -> [Utf8Builder ()])
-> [Utf8Builder ()] -> [Utf8Builder ()]
forall a b. (a -> b) -> a -> b
$ (Tag -> Utf8Builder ()) -> [Tag] -> [Utf8Builder ()]
forall a b. (a -> b) -> [a] -> [b]
map Tag -> Utf8Builder ()
fromTag [Tag]
ts

data ServiceCheckStatus
  = ServiceOk
  | ServiceWarning
  | ServiceCritical
  | ServiceUnknown
  deriving (ReadPrec [ServiceCheckStatus]
ReadPrec ServiceCheckStatus
Int -> ReadS ServiceCheckStatus
ReadS [ServiceCheckStatus]
(Int -> ReadS ServiceCheckStatus)
-> ReadS [ServiceCheckStatus]
-> ReadPrec ServiceCheckStatus
-> ReadPrec [ServiceCheckStatus]
-> Read ServiceCheckStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ServiceCheckStatus]
$creadListPrec :: ReadPrec [ServiceCheckStatus]
readPrec :: ReadPrec ServiceCheckStatus
$creadPrec :: ReadPrec ServiceCheckStatus
readList :: ReadS [ServiceCheckStatus]
$creadList :: ReadS [ServiceCheckStatus]
readsPrec :: Int -> ReadS ServiceCheckStatus
$creadsPrec :: Int -> ReadS ServiceCheckStatus
Read, Int -> ServiceCheckStatus -> ShowS
[ServiceCheckStatus] -> ShowS
ServiceCheckStatus -> String
(Int -> ServiceCheckStatus -> ShowS)
-> (ServiceCheckStatus -> String)
-> ([ServiceCheckStatus] -> ShowS)
-> Show ServiceCheckStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServiceCheckStatus] -> ShowS
$cshowList :: [ServiceCheckStatus] -> ShowS
show :: ServiceCheckStatus -> String
$cshow :: ServiceCheckStatus -> String
showsPrec :: Int -> ServiceCheckStatus -> ShowS
$cshowsPrec :: Int -> ServiceCheckStatus -> ShowS
Show, ServiceCheckStatus -> ServiceCheckStatus -> Bool
(ServiceCheckStatus -> ServiceCheckStatus -> Bool)
-> (ServiceCheckStatus -> ServiceCheckStatus -> Bool)
-> Eq ServiceCheckStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServiceCheckStatus -> ServiceCheckStatus -> Bool
$c/= :: ServiceCheckStatus -> ServiceCheckStatus -> Bool
== :: ServiceCheckStatus -> ServiceCheckStatus -> Bool
$c== :: ServiceCheckStatus -> ServiceCheckStatus -> Bool
Eq, Eq ServiceCheckStatus
Eq ServiceCheckStatus
-> (ServiceCheckStatus -> ServiceCheckStatus -> Ordering)
-> (ServiceCheckStatus -> ServiceCheckStatus -> Bool)
-> (ServiceCheckStatus -> ServiceCheckStatus -> Bool)
-> (ServiceCheckStatus -> ServiceCheckStatus -> Bool)
-> (ServiceCheckStatus -> ServiceCheckStatus -> Bool)
-> (ServiceCheckStatus -> ServiceCheckStatus -> ServiceCheckStatus)
-> (ServiceCheckStatus -> ServiceCheckStatus -> ServiceCheckStatus)
-> Ord ServiceCheckStatus
ServiceCheckStatus -> ServiceCheckStatus -> Bool
ServiceCheckStatus -> ServiceCheckStatus -> Ordering
ServiceCheckStatus -> ServiceCheckStatus -> ServiceCheckStatus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ServiceCheckStatus -> ServiceCheckStatus -> ServiceCheckStatus
$cmin :: ServiceCheckStatus -> ServiceCheckStatus -> ServiceCheckStatus
max :: ServiceCheckStatus -> ServiceCheckStatus -> ServiceCheckStatus
$cmax :: ServiceCheckStatus -> ServiceCheckStatus -> ServiceCheckStatus
>= :: ServiceCheckStatus -> ServiceCheckStatus -> Bool
$c>= :: ServiceCheckStatus -> ServiceCheckStatus -> Bool
> :: ServiceCheckStatus -> ServiceCheckStatus -> Bool
$c> :: ServiceCheckStatus -> ServiceCheckStatus -> Bool
<= :: ServiceCheckStatus -> ServiceCheckStatus -> Bool
$c<= :: ServiceCheckStatus -> ServiceCheckStatus -> Bool
< :: ServiceCheckStatus -> ServiceCheckStatus -> Bool
$c< :: ServiceCheckStatus -> ServiceCheckStatus -> Bool
compare :: ServiceCheckStatus -> ServiceCheckStatus -> Ordering
$ccompare :: ServiceCheckStatus -> ServiceCheckStatus -> Ordering
$cp1Ord :: Eq ServiceCheckStatus
Ord, Int -> ServiceCheckStatus
ServiceCheckStatus -> Int
ServiceCheckStatus -> [ServiceCheckStatus]
ServiceCheckStatus -> ServiceCheckStatus
ServiceCheckStatus -> ServiceCheckStatus -> [ServiceCheckStatus]
ServiceCheckStatus
-> ServiceCheckStatus -> ServiceCheckStatus -> [ServiceCheckStatus]
(ServiceCheckStatus -> ServiceCheckStatus)
-> (ServiceCheckStatus -> ServiceCheckStatus)
-> (Int -> ServiceCheckStatus)
-> (ServiceCheckStatus -> Int)
-> (ServiceCheckStatus -> [ServiceCheckStatus])
-> (ServiceCheckStatus
    -> ServiceCheckStatus -> [ServiceCheckStatus])
-> (ServiceCheckStatus
    -> ServiceCheckStatus -> [ServiceCheckStatus])
-> (ServiceCheckStatus
    -> ServiceCheckStatus
    -> ServiceCheckStatus
    -> [ServiceCheckStatus])
-> Enum ServiceCheckStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ServiceCheckStatus
-> ServiceCheckStatus -> ServiceCheckStatus -> [ServiceCheckStatus]
$cenumFromThenTo :: ServiceCheckStatus
-> ServiceCheckStatus -> ServiceCheckStatus -> [ServiceCheckStatus]
enumFromTo :: ServiceCheckStatus -> ServiceCheckStatus -> [ServiceCheckStatus]
$cenumFromTo :: ServiceCheckStatus -> ServiceCheckStatus -> [ServiceCheckStatus]
enumFromThen :: ServiceCheckStatus -> ServiceCheckStatus -> [ServiceCheckStatus]
$cenumFromThen :: ServiceCheckStatus -> ServiceCheckStatus -> [ServiceCheckStatus]
enumFrom :: ServiceCheckStatus -> [ServiceCheckStatus]
$cenumFrom :: ServiceCheckStatus -> [ServiceCheckStatus]
fromEnum :: ServiceCheckStatus -> Int
$cfromEnum :: ServiceCheckStatus -> Int
toEnum :: Int -> ServiceCheckStatus
$ctoEnum :: Int -> ServiceCheckStatus
pred :: ServiceCheckStatus -> ServiceCheckStatus
$cpred :: ServiceCheckStatus -> ServiceCheckStatus
succ :: ServiceCheckStatus -> ServiceCheckStatus
$csucc :: ServiceCheckStatus -> ServiceCheckStatus
Enum)

-- | 'ServiceCheck'
--
-- The fields accessible through corresponding lenses are:
--
-- * 'name' @::@ 'Text'
--
-- * 'status' @::@ 'ServiceCheckStatus'
--
-- * 'message' @::@ 'Maybe' 'Text'
--
-- * 'dateHappened' @::@ 'Maybe' 'UTCTime'
--
-- * 'hostname' @::@ 'Maybe' 'Text'
--
-- * 'tags' @::@ @[@'Tag'@]@
data ServiceCheck = ServiceCheck
  { ServiceCheck -> Text
serviceCheckName         :: {-# UNPACK #-} !Text
  , ServiceCheck -> ServiceCheckStatus
serviceCheckStatus       :: !ServiceCheckStatus
  , ServiceCheck -> Maybe Text
serviceCheckMessage      :: !(Maybe Text)
  , ServiceCheck -> Maybe UTCTime
serviceCheckDateHappened :: !(Maybe UTCTime)
  , ServiceCheck -> Maybe Text
serviceCheckHostname     :: !(Maybe Text)
  , ServiceCheck -> [Tag]
serviceCheckTags         :: ![Tag]
  }

makeFields ''ServiceCheck

serviceCheck ::
     Text -- ^ name
  -> ServiceCheckStatus
  -> ServiceCheck
serviceCheck :: Text -> ServiceCheckStatus -> ServiceCheck
serviceCheck Text
n ServiceCheckStatus
s = Text
-> ServiceCheckStatus
-> Maybe Text
-> Maybe UTCTime
-> Maybe Text
-> [Tag]
-> ServiceCheck
ServiceCheck Text
n ServiceCheckStatus
s Maybe Text
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing []

-- | Convert an 'Event', 'Metric', or 'StatusCheck' to their wire format.
class ToStatsD a where
  toStatsD :: a -> Utf8Builder ()

instance ToStatsD Metric where
  toStatsD :: Metric -> Utf8Builder ()
toStatsD = Metric -> Utf8Builder ()
renderMetric

instance ToStatsD Event where
  toStatsD :: Event -> Utf8Builder ()
toStatsD = Event -> Utf8Builder ()
renderEvent

instance ToStatsD ServiceCheck where
  toStatsD :: ServiceCheck -> Utf8Builder ()
toStatsD ServiceCheck
check = do
    ByteString -> Utf8Builder ()
appendBS7 ByteString
"_sc|"
    Text -> Utf8Builder ()
appendText (Text -> Utf8Builder ()) -> Text -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cleanMetricText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ServiceCheck
check ServiceCheck -> Getting Text ServiceCheck Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text ServiceCheck Text
forall s a. HasName s a => Lens' s a
name
    Char -> Utf8Builder ()
appendChar7 Char
'|'
    Int -> Utf8Builder ()
appendDecimalSignedInt (Int -> Utf8Builder ()) -> Int -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ ServiceCheckStatus -> Int
forall a. Enum a => a -> Int
fromEnum (ServiceCheckStatus -> Int) -> ServiceCheckStatus -> Int
forall a b. (a -> b) -> a -> b
$ ServiceCheck
check ServiceCheck
-> Getting ServiceCheckStatus ServiceCheck ServiceCheckStatus
-> ServiceCheckStatus
forall s a. s -> Getting a s a -> a
^. Getting ServiceCheckStatus ServiceCheck ServiceCheckStatus
forall s a. HasStatus s a => Lens' s a
status
    Maybe Text -> (Text -> Utf8Builder ()) -> Utf8Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ (ServiceCheck
check ServiceCheck
-> Getting (Maybe Text) ServiceCheck (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) ServiceCheck (Maybe Text)
forall s a. HasMessage s a => Lens' s a
message) ((Text -> Utf8Builder ()) -> Utf8Builder ())
-> (Text -> Utf8Builder ()) -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ \Text
msg ->
      ByteString -> Utf8Builder ()
appendBS7 ByteString
"|m:" Utf8Builder () -> Utf8Builder () -> Utf8Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Utf8Builder ()
appendText (Text -> Text
cleanMetricText Text
msg)
    Maybe UTCTime -> (UTCTime -> Utf8Builder ()) -> Utf8Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ (ServiceCheck
check ServiceCheck
-> Getting (Maybe UTCTime) ServiceCheck (Maybe UTCTime)
-> Maybe UTCTime
forall s a. s -> Getting a s a -> a
^. Getting (Maybe UTCTime) ServiceCheck (Maybe UTCTime)
forall s a. HasDateHappened s a => Lens' s a
dateHappened) ((UTCTime -> Utf8Builder ()) -> Utf8Builder ())
-> (UTCTime -> Utf8Builder ()) -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ \UTCTime
ts -> do
      ByteString -> Utf8Builder ()
appendBS7 ByteString
"|d:"
      Int -> Utf8Builder ()
appendDecimalSignedInt (Int -> Utf8Builder ()) -> Int -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> Int
epochTime UTCTime
ts
    Maybe Text -> (Text -> Utf8Builder ()) -> Utf8Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ (ServiceCheck
check ServiceCheck
-> Getting (Maybe Text) ServiceCheck (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) ServiceCheck (Maybe Text)
forall s a. HasHostname s a => Lens' s a
hostname) ((Text -> Utf8Builder ()) -> Utf8Builder ())
-> (Text -> Utf8Builder ()) -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ \Text
hn ->
      ByteString -> Utf8Builder ()
appendBS7 ByteString
"|h:" Utf8Builder () -> Utf8Builder () -> Utf8Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Utf8Builder ()
appendText (Text -> Text
cleanMetricText Text
hn)
    case ServiceCheck
check ServiceCheck -> Getting [Tag] ServiceCheck [Tag] -> [Tag]
forall s a. s -> Getting a s a -> a
^. Getting [Tag] ServiceCheck [Tag]
forall s a. HasTags s a => Lens' s a
tags of
      [] -> () -> Utf8Builder ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [Tag]
ts -> do
        ByteString -> Utf8Builder ()
appendBS7 ByteString
"|#"
        [Utf8Builder ()] -> Utf8Builder ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Utf8Builder ()] -> Utf8Builder ())
-> [Utf8Builder ()] -> Utf8Builder ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder () -> [Utf8Builder ()] -> [Utf8Builder ()]
forall a. a -> [a] -> [a]
intersperse (Char -> Utf8Builder ()
appendChar7 Char
',') ([Utf8Builder ()] -> [Utf8Builder ()])
-> [Utf8Builder ()] -> [Utf8Builder ()]
forall a b. (a -> b) -> a -> b
$ (Tag -> Utf8Builder ()) -> [Tag] -> [Utf8Builder ()]
forall a b. (a -> b) -> [a] -> [b]
map Tag -> Utf8Builder ()
fromTag [Tag]
ts

data DogStatsSettings = DogStatsSettings
  { DogStatsSettings -> String
dogStatsSettingsHost        :: HostName -- ^ The hostname or IP of the DogStatsD server (default: 127.0.0.1)
  , DogStatsSettings -> Int
dogStatsSettingsPort        :: !Int -- ^ The port that the DogStatsD server is listening on (default: 8125)
  , DogStatsSettings -> Int
dogStatsSettingsBufferSize  :: !Int -- ^ Maximum buffer size. Stats are sent over UDP, so the maximum possible value is 65507 bytes per packet. In some scenarios, however, you may wish to send smaller packets. (default: 65507)
  , DogStatsSettings -> Int
dogStatsSettingsMaxDelay    :: !Int -- ^ Maximum amount of time (in microseconds) between having no stats to send locally and when new stats will be sent to the statsd server. (default: 1 second)
  , DogStatsSettings
-> SomeException
-> Seq ByteString
-> IO (Seq ByteString -> Seq ByteString)
dogStatsSettingsOnException :: (SomeException -> Seq.Seq ByteString -> IO (Seq.Seq ByteString -> Seq.Seq ByteString)) -- ^ Handler to recover from exceptions thrown while sending stats to the server. Caution: Throwing an exception from this handler will shut down the worker that sends stats to the server, but is not able to prevent you from enqueuing stats via the client. Default: print the exception and throw away any accumulated stats.
  }

makeFields ''DogStatsSettings

defaultSettings :: DogStatsSettings
defaultSettings :: DogStatsSettings
defaultSettings =
  DogStatsSettings :: String
-> Int
-> Int
-> Int
-> (SomeException
    -> Seq ByteString -> IO (Seq ByteString -> Seq ByteString))
-> DogStatsSettings
DogStatsSettings
    { dogStatsSettingsHost :: String
dogStatsSettingsHost = String
"127.0.0.1"
    , dogStatsSettingsPort :: Int
dogStatsSettingsPort = Int
8125
    , dogStatsSettingsBufferSize :: Int
dogStatsSettingsBufferSize = Int
65507
    , dogStatsSettingsMaxDelay :: Int
dogStatsSettingsMaxDelay = Int
1000000
    , dogStatsSettingsOnException :: SomeException
-> Seq ByteString -> IO (Seq ByteString -> Seq ByteString)
dogStatsSettingsOnException =
        \SomeException
e Seq ByteString
_ ->
          String -> IO ()
putStrLn
            (SomeException -> String
forall a. Show a => a -> String
show SomeException
e String -> ShowS
forall a. [a] -> [a] -> [a]
++
             String
"\nDropping all accumulated stats due to error. This behavior may be overridden by setting the onException handler of DogStatsSettings.") IO ()
-> IO (Seq ByteString -> Seq ByteString)
-> IO (Seq ByteString -> Seq ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          (Seq ByteString -> Seq ByteString)
-> IO (Seq ByteString -> Seq ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq ByteString -> Seq ByteString -> Seq ByteString
forall a b. a -> b -> a
const Seq ByteString
forall a. Seq a
Seq.empty)
    }

accumulateStats ::
     Int -- ^ Max buffer size
  -> Seq.Seq ByteString -- ^ Items to send
  -> (L.ByteString, Seq.Seq ByteString)
accumulateStats :: Int -> Seq ByteString -> (ByteString, Seq ByteString)
accumulateStats Int
maxBufSize = Int
-> [ByteString] -> Seq ByteString -> (ByteString, Seq ByteString)
go Int
0 []
  where
    go :: Int -> [ByteString] -> Seq.Seq ByteString -> (L.ByteString, Seq.Seq ByteString)
    go :: Int
-> [ByteString] -> Seq ByteString -> (ByteString, Seq ByteString)
go !Int
accum [ByteString]
chunks Seq ByteString
s = case Seq ByteString -> ViewL ByteString
forall a. Seq a -> ViewL a
Seq.viewl Seq ByteString
s of
      ViewL ByteString
Seq.EmptyL -> ([ByteString] -> ByteString
finalizeChunks [ByteString]
chunks, Seq ByteString
forall a. Seq a
Seq.empty)
      (ByteString
bs Seq.:< Seq ByteString
rest) -> let newSize :: Int
newSize = ByteString -> Int
B.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
accum in if Int
newSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxBufSize
        then ([ByteString] -> ByteString
finalizeChunks [ByteString]
chunks, Seq ByteString
s)
        else Int
-> [ByteString] -> Seq ByteString -> (ByteString, Seq ByteString)
go Int
newSize (ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
chunks) Seq ByteString
rest

    finalizeChunks :: [ByteString] -> L.ByteString
    finalizeChunks :: [ByteString] -> ByteString
finalizeChunks = [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse

-- | Create a stats client. Be sure to close it with 'finalizeStatsClient' in order to send any pending stats and close the underlying handle when done using it. Alternatively, use 'withDogStatsD' to finalize it automatically.
mkStatsClient :: MonadIO m => DogStatsSettings -> m StatsClient
mkStatsClient :: DogStatsSettings -> m StatsClient
mkStatsClient DogStatsSettings
s = IO StatsClient -> m StatsClient
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StatsClient -> m StatsClient)
-> IO StatsClient -> m StatsClient
forall a b. (a -> b) -> a -> b
$ do
  [AddrInfo]
addrInfos <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo
               (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just (AddrInfo -> Maybe AddrInfo) -> AddrInfo -> Maybe AddrInfo
forall a b. (a -> b) -> a -> b
$ AddrInfo
defaultHints { addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_PASSIVE] })
               (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ DogStatsSettings
s DogStatsSettings
-> Getting String DogStatsSettings String -> String
forall s a. s -> Getting a s a -> a
^. Getting String DogStatsSettings String
forall s a. HasHost s a => Lens' s a
host)
               (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ DogStatsSettings
s DogStatsSettings -> Getting Int DogStatsSettings Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int DogStatsSettings Int
forall s a. HasPort s a => Lens' s a
port)
  case [AddrInfo]
addrInfos of
    [] -> String -> IO StatsClient
forall a. HasCallStack => String -> a
error String
"No address for hostname" -- TODO throw
    (AddrInfo
serverAddr:[AddrInfo]
_) -> do
      Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
serverAddr) SocketType
Datagram ProtocolNumber
defaultProtocol
      Socket -> SockAddr -> IO ()
connect Socket
sock (AddrInfo -> SockAddr
addrAddress AddrInfo
serverAddr)
      Handle
h <- Socket -> IOMode -> IO Handle
socketToHandle Socket
sock IOMode
WriteMode
      Handle -> BufferMode -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> BufferMode -> m ()
hSetBuffering Handle
h (Maybe Int -> BufferMode
BlockBuffering (Maybe Int -> BufferMode) -> Maybe Int -> BufferMode
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ DogStatsSettings -> Int
dogStatsSettingsBufferSize DogStatsSettings
s)
      let reaperSettings :: ReaperSettings (Seq ByteString) (Utf8Builder ())
reaperSettings = ReaperSettings [Any] Any
forall item. ReaperSettings [item] item
defaultReaperSettings
            { reaperAction :: Seq ByteString -> IO (Seq ByteString -> Seq ByteString)
reaperAction = \Seq ByteString
stats -> IO (Seq ByteString -> Seq ByteString)
-> (SomeException -> IO (Seq ByteString -> Seq ByteString))
-> IO (Seq ByteString -> Seq ByteString)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch (Handle
-> Int -> Seq ByteString -> IO (Seq ByteString -> Seq ByteString)
builderAction Handle
h (DogStatsSettings -> Int
dogStatsSettingsBufferSize DogStatsSettings
s) Seq ByteString
stats) ((SomeException -> IO (Seq ByteString -> Seq ByteString))
 -> IO (Seq ByteString -> Seq ByteString))
-> (SomeException -> IO (Seq ByteString -> Seq ByteString))
-> IO (Seq ByteString -> Seq ByteString)
forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
                DogStatsSettings
-> SomeException
-> Seq ByteString
-> IO (Seq ByteString -> Seq ByteString)
dogStatsSettingsOnException DogStatsSettings
s SomeException
e Seq ByteString
stats
            , reaperDelay :: Int
reaperDelay = DogStatsSettings -> Int
dogStatsSettingsMaxDelay DogStatsSettings
s
            , reaperCons :: Utf8Builder () -> Seq ByteString -> Seq ByteString
reaperCons = \Utf8Builder ()
item Seq ByteString
work -> Seq ByteString
work Seq ByteString -> ByteString -> Seq ByteString
forall a. Seq a -> a -> Seq a
Seq.|> Utf8Builder () -> ByteString
runUtf8Builder Utf8Builder ()
item
            , reaperNull :: Seq ByteString -> Bool
reaperNull = Seq ByteString -> Bool
forall a. Seq a -> Bool
Seq.null
            , reaperEmpty :: Seq ByteString
reaperEmpty = Seq ByteString
forall a. Seq a
Seq.empty
            }
      Reaper (Seq ByteString) (Utf8Builder ())
r <- ReaperSettings (Seq ByteString) (Utf8Builder ())
-> IO (Reaper (Seq ByteString) (Utf8Builder ()))
forall workload item.
ReaperSettings workload item -> IO (Reaper workload item)
mkReaper ReaperSettings (Seq ByteString) (Utf8Builder ())
reaperSettings
      StatsClient -> IO StatsClient
forall (m :: * -> *) a. Monad m => a -> m a
return (StatsClient -> IO StatsClient) -> StatsClient -> IO StatsClient
forall a b. (a -> b) -> a -> b
$ Handle
-> Reaper (Seq ByteString) (Utf8Builder ())
-> DogStatsSettings
-> StatsClient
StatsClient Handle
h Reaper (Seq ByteString) (Utf8Builder ())
r DogStatsSettings
s

builderAction :: Handle -> Int -> Seq.Seq ByteString -> IO (Seq.Seq ByteString -> Seq.Seq ByteString)
builderAction :: Handle
-> Int -> Seq ByteString -> IO (Seq ByteString -> Seq ByteString)
builderAction Handle
h Int
maxBufSize Seq ByteString
s = case Seq ByteString -> ViewL ByteString
forall a. Seq a -> ViewL a
Seq.viewl Seq ByteString
s of
  ViewL ByteString
Seq.EmptyL -> (Seq ByteString -> Seq ByteString)
-> IO (Seq ByteString -> Seq ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Seq ByteString -> Seq ByteString)
 -> IO (Seq ByteString -> Seq ByteString))
-> (Seq ByteString -> Seq ByteString)
-> IO (Seq ByteString -> Seq ByteString)
forall a b. (a -> b) -> a -> b
$ Seq ByteString -> Seq ByteString -> Seq ByteString
forall a b. a -> b -> a
const Seq ByteString
forall a. Seq a
Seq.empty
  ViewL ByteString
_ -> do
    let (ByteString
toFlush, Seq ByteString
rest) = Int -> Seq ByteString -> (ByteString, Seq ByteString)
accumulateStats Int
maxBufSize Seq ByteString
s
    Handle -> ByteString -> IO ()
L.hPut Handle
h ByteString
toFlush
    Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
h -- safety flush
    Handle
-> Int -> Seq ByteString -> IO (Seq ByteString -> Seq ByteString)
builderAction Handle
h Int
maxBufSize Seq ByteString
rest

-- | Create a 'StatsClient' and provide it to the provided function. The 'StatsClient' will be finalized as soon as the inner block is exited, whether normally or via an exception.
withDogStatsD :: MonadUnliftIO m => DogStatsSettings -> (StatsClient -> m a) -> m a
withDogStatsD :: DogStatsSettings -> (StatsClient -> m a) -> m a
withDogStatsD DogStatsSettings
s = m StatsClient
-> (StatsClient -> m ()) -> (StatsClient -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (DogStatsSettings -> m StatsClient
forall (m :: * -> *).
MonadIO m =>
DogStatsSettings -> m StatsClient
mkStatsClient DogStatsSettings
s) StatsClient -> m ()
forall (m :: * -> *). MonadIO m => StatsClient -> m ()
finalizeStatsClient

-- | Note that Dummy is not the only constructor, just the only publicly available one.
data StatsClient = StatsClient
                   { StatsClient -> Handle
statsClientHandle :: !Handle
                   , StatsClient -> Reaper (Seq ByteString) (Utf8Builder ())
statsClientReaper :: Reaper (Seq.Seq ByteString) (Utf8Builder ())
                   , StatsClient -> DogStatsSettings
statsClientSettings :: DogStatsSettings
                   }
                 | Dummy -- ^ Just drops all stats.

-- | Send a 'Metric', 'Event', or 'StatusCheck' to the DogStatsD server.
--
-- Since UDP is used to send the events,
-- there is no ack that sent values are successfully dealt with.
--
-- > withDogStatsD defaultSettings $ \client -> do
-- >   send client $ event "Wombat attack" "A host of mighty wombats has breached the gates"
-- >   send client $ metric "wombat.force_count" Gauge (9001 :: Int)
-- >   send client $ serviceCheck "Wombat Radar" ServiceOk
send :: (MonadIO m, ToStatsD v) => StatsClient -> v -> m ()
send :: StatsClient -> v -> m ()
send StatsClient {Reaper (Seq ByteString) (Utf8Builder ())
statsClientReaper :: Reaper (Seq ByteString) (Utf8Builder ())
statsClientReaper :: StatsClient -> Reaper (Seq ByteString) (Utf8Builder ())
statsClientReaper} v
v =
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Reaper (Seq ByteString) (Utf8Builder ()) -> Utf8Builder () -> IO ()
forall workload item. Reaper workload item -> item -> IO ()
reaperAdd Reaper (Seq ByteString) (Utf8Builder ())
statsClientReaper (v -> Utf8Builder ()
forall a. ToStatsD a => a -> Utf8Builder ()
toStatsD v
v Utf8Builder () -> Utf8Builder () -> Utf8Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Utf8Builder ()
appendChar7 Char
'\n')
send StatsClient
Dummy v
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINEABLE send #-}

-- | Send all pending unsent events and close the connection to the specified statsd server.
finalizeStatsClient :: MonadIO m => StatsClient -> m ()
finalizeStatsClient :: StatsClient -> m ()
finalizeStatsClient (StatsClient Handle
h Reaper (Seq ByteString) (Utf8Builder ())
r DogStatsSettings
s) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Seq ByteString
remainingStats <- Reaper (Seq ByteString) (Utf8Builder ()) -> IO (Seq ByteString)
forall workload item. Reaper workload item -> IO workload
reaperStop Reaper (Seq ByteString) (Utf8Builder ())
r
  IO (Seq ByteString -> Seq ByteString) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Seq ByteString -> Seq ByteString) -> IO ())
-> IO (Seq ByteString -> Seq ByteString) -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle
-> Int -> Seq ByteString -> IO (Seq ByteString -> Seq ByteString)
builderAction Handle
h (DogStatsSettings -> Int
dogStatsSettingsBufferSize DogStatsSettings
s) Seq ByteString
remainingStats
  Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hClose Handle
h
finalizeStatsClient StatsClient
Dummy = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()