{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Network.StatsD.Datadog (
DogStatsSettings(..),
defaultSettings,
withDogStatsD,
mkStatsClient,
finalizeStatsClient,
send,
metric,
Metric,
MetricName(..),
MetricType(..),
event,
Event,
serviceCheck,
ServiceCheck,
ServiceCheckStatus(..),
ToStatsD,
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(..),
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 #-}
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
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
| Counter
| Timer
| Histogram
| Set
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
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) []
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
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
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 []
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
"}:"
ByteString -> Utf8Builder ()
unsafeAppendBS ByteString
escapedTitle
Char -> Utf8Builder ()
appendChar7 Char
'|'
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
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)
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
-> 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 []
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
, DogStatsSettings -> Int
dogStatsSettingsPort :: !Int
, DogStatsSettings -> Int
dogStatsSettingsBufferSize :: !Int
, DogStatsSettings -> Int
dogStatsSettingsMaxDelay :: !Int
, DogStatsSettings
-> SomeException
-> Seq ByteString
-> IO (Seq ByteString -> Seq ByteString)
dogStatsSettingsOnException :: (SomeException -> Seq.Seq ByteString -> IO (Seq.Seq ByteString -> Seq.Seq ByteString))
}
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
-> Seq.Seq ByteString
-> (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
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"
(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
Handle
-> Int -> Seq ByteString -> IO (Seq ByteString -> Seq ByteString)
builderAction Handle
h Int
maxBufSize Seq ByteString
rest
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
data StatsClient = StatsClient
{ StatsClient -> Handle
statsClientHandle :: !Handle
, StatsClient -> Reaper (Seq ByteString) (Utf8Builder ())
statsClientReaper :: Reaper (Seq.Seq ByteString) (Utf8Builder ())
, StatsClient -> DogStatsSettings
statsClientSettings :: DogStatsSettings
}
| Dummy
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 #-}
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 ()