arbor-datadog (empty) → 0.0.0.1
raw patch · 9 files changed
+669/−0 lines, 9 filesdep +Cabaldep +aesondep +arbor-datadogsetup-changed
Dependencies added: Cabal, aeson, arbor-datadog, auto-update, base, buffer-builder, bytestring, dlist, generic-lens, hspec, lens, mtl, network, random, resourcet, text, time, transformers, unordered-containers, vector
Files
- LICENSE +22/−0
- Setup.hs +2/−0
- arbor-datadog.cabal +72/−0
- src/Arbor/Network/StatsD.hs +6/−0
- src/Arbor/Network/StatsD/Datadog.hs +380/−0
- src/Arbor/Network/StatsD/Internal/Lens.hs +7/−0
- src/Arbor/Network/StatsD/Monad.hs +38/−0
- src/Arbor/Network/StatsD/Type.hs +141/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,22 @@+The MIT License (MIT)++Copyright (c) 2015 Ian Duncan+Copyright (c) 2017-2018 Arbor Networks++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ arbor-datadog.cabal view
@@ -0,0 +1,72 @@+-- This file has been generated from package.yaml by hpack version 0.18.1.+--+-- see: https://github.com/sol/hpack++name: arbor-datadog+version: 0.0.0.1+synopsis: Datadog client for Haskell.+description: Datadog client for Haskell. Supports both the HTTP API and StatsD.+category: Network+homepage: https://github.com/arbor/arbor-datadog+author: Arbor Networks+maintainer: mayhem@arbor.net+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++source-repository head+ type: git+ location: git://github.com/arbor/arbor-datadog.git++library+ hs-source-dirs:+ src+ other-extensions: OverloadedStrings GeneralizedNewtypeDeriving TemplateHaskell FunctionalDependencies MultiParamTypeClasses FlexibleInstances+ ghc-options: -Wall+ build-depends:+ generic-lens+ , lens+ , network+ , resourcet+ , time+ , transformers+ , base >=4.7 && <5+ , aeson+ , auto-update+ , buffer-builder+ , bytestring+ , dlist+ , mtl+ , random+ , text+ , unordered-containers+ , vector+ exposed-modules:+ Arbor.Network.StatsD+ Arbor.Network.StatsD.Datadog+ Arbor.Network.StatsD.Internal.Lens+ Arbor.Network.StatsD.Monad+ Arbor.Network.StatsD.Type+ other-modules:+ Paths_arbor_datadog+ default-language: Haskell2010++test-suite datadog-api-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test+ ghc-options: -Wall -O3 -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ generic-lens+ , lens+ , network+ , resourcet+ , time+ , transformers+ , base+ , Cabal+ , arbor-datadog+ , hspec+ default-language: Haskell2010
+ src/Arbor/Network/StatsD.hs view
@@ -0,0 +1,6 @@+module Arbor.Network.StatsD+( module X+) where++import Arbor.Network.StatsD.Datadog as X+import Arbor.Network.StatsD.Monad as X
+ src/Arbor/Network/StatsD/Datadog.hs view
@@ -0,0 +1,380 @@+{-| 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 DataKinds #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++module Arbor.Network.StatsD.Datadog+ ( -- * Client interface+ Z.DogStatsSettings(..)+ , defaultSettings+ , createStatsClient+ , closeStatsClient+ , send+ , sendSampled+ , sendEvt+ -- * Data supported by DogStatsD+ , metric+ , Z.Metric+ , Z.MetricName+ , Z.MetricType+ , event+ , Z.Event+ , serviceCheck+ , Z.ServiceCheck+ , Z.ServiceCheckStatus+ , ToStatsD+ -- * Optional fields+ , Z.Tag+ , envTag+ , tag+ , tagged+ , sampled+ , sampled'+ , incCounter+ , addCounter+ , gauge+ , timer+ , histogram+ , ToMetricValue(..)+ , value+ , Z.SampleRate+ , Z.Priority(..)+ , Z.AlertType(..)+ -- * Dummy client+ , Z.StatsClient(Dummy)+) where++import Control.Applicative ((<$>))+import Control.Lens+import Control.Monad (when)+import Control.Monad.IO.Class+import Control.Reaper+import Data.BufferBuilder.Utf8+import Data.Generics.Product.Any+import Data.Generics.Product.Typed+import Data.List (intersperse)+import Data.Maybe (isNothing)+import Data.Semigroup ((<>))+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import Data.Time.Clock+import Data.Time.Clock.POSIX+import Network.Socket hiding (recv, recvFrom, send, sendTo)+import System.Environment+import System.IO (BufferMode (LineBuffering), IOMode (WriteMode), hClose, hSetBuffering)+import System.Random (randomIO)++import qualified Arbor.Network.StatsD.Type as Z+import qualified Data.ByteString as B+import qualified Data.Foldable as F+import qualified Data.Text as T++epochTime :: UTCTime -> Int+epochTime = round . utcTimeToPOSIXSeconds++sampleAlways :: Z.SampleRate+sampleAlways = Z.SampleRate 1.0++cleanMetricText :: Text -> Text+cleanMetricText = T.map $ \c -> case c of+ ':' -> '_'+ '|' -> '_'+ '@' -> '_'+ _ -> c+{-# INLINE cleanMetricText #-}++escapeEventContents :: T.Text -> T.Text+escapeEventContents = T.replace "\n" "\\n"+{-# INLINE escapeEventContents #-}++-- | 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 -> Z.Tag+tag k v = Z.Tag (build k >> appendChar7 ':' >> build v)+ where+ build = appendText . cleanMetricText++-- | 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 = appendDecimalSignedInt++instance ToMetricValue Double where+ encodeValue = appendDecimalDouble++-- | Smart 'Metric' constructor. Use the lens functions to set the optional fields.+metric :: (ToMetricValue a) => Z.MetricName -> Z.MetricType -> a -> Z.Metric+metric n t v = Z.Metric n sampleAlways t (encodeValue v) []++-- | Special setter to update the value of a 'Metric'.+--+-- > metric ("foo"" :: Text) Counter (1 :: Int) & value .~ (5 :: Double)+value :: ToMetricValue a => Setter Z.Metric Z.Metric (Utf8Builder ()) a+value = sets $ \f m -> m { Z.value = encodeValue $ f $ Z.value m }+{-# INLINE value #-}++renderMetric :: Z.Metric -> Utf8Builder ()+renderMetric (Z.Metric n (Z.SampleRate sr) t v ts) = do+ appendText $ cleanMetricText $ n ^. the @"text"+ appendChar7 ':'+ v+ appendChar7 '|'+ unit+ formatRate+ formatTags+ where+ unit = case t of+ Z.Gauge -> appendChar7 'g'+ Z.Counter -> appendChar7 'c'+ Z.Timer -> appendBS7 "ms"+ Z.Histogram -> appendChar7 'h'+ Z.Set -> appendChar7 's'+ formatTags = case ts of+ [] -> return ()+ xs -> appendBS7 "|#" >> F.sequence_ (intersperse (appendChar7 ',') $ map (^. the @"builder") xs)+ formatRate = if sr == 1 then return () else appendBS7 "|@" >> appendDecimalDouble sr++-- | Smart 'Event' constructor. Use the lens functions to set the optional fields.+event :: Text -> Text -> Z.Event+event t d = Z.Event t d Nothing Nothing Nothing Nothing Nothing Nothing []++renderEvent :: Z.Event -> Utf8Builder ()+renderEvent e = do+ appendBS7 "_e{"+ encodeValue $ B.length escapedTitle+ appendChar7 ','+ encodeValue $ B.length escapedText+ appendBS7 "}:"+ -- This is safe because we encodeUtf8 below+ -- We do so to get the length of the ultimately encoded bytes for the datagram format+ unsafeAppendBS escapedTitle+ appendChar7 '|'+ -- This is safe because we encodeUtf8 below+ -- We do so to get the length of the ultimately encoded bytes for the datagram format+ unsafeAppendBS escapedText+ happened+ formatHostname+ aggregation+ formatPriority+ sourceType+ alert+ formatTags+ where+ escapedTitle :: B.ByteString+ escapedTitle = encodeUtf8 $ escapeEventContents $ e ^. the @"title"+ escapedText :: B.ByteString+ escapedText = encodeUtf8 $ escapeEventContents $ e ^. the @"text"+ makeField :: Foldable t => Char -> t (Utf8Builder b) -> Utf8Builder ()+ makeField c v = F.forM_ v $ \jv ->+ appendChar7 '|' >> appendChar7 c >> appendChar7 ':' >> jv+ cleanTextValue :: Functor f => (Z.Event -> f Text) -> f (Utf8Builder ())+ cleanTextValue f = (appendText . cleanMetricText) <$> f e+ -- TODO figure out the actual format that dateHappened values are supposed to have.+ happened :: Utf8Builder ()+ happened = F.forM_ (e ^. the @"dateHappened") $ \h -> do+ appendBS7 "|d:"+ appendDecimalSignedInt $ epochTime h+ formatHostname :: Utf8Builder ()+ formatHostname = makeField 'h' $ cleanTextValue (^. the @"hostname")+ aggregation :: Utf8Builder ()+ aggregation = makeField 'k' $ cleanTextValue (^. the @"aggregationKey")+ formatPriority :: Utf8Builder ()+ formatPriority = F.forM_ (e ^. the @"priority") $ \p -> do+ appendBS7 "|p:"+ appendBS7 $ case p of+ Z.Low -> "low"+ Z.Normal -> "normal"+ sourceType :: Utf8Builder ()+ sourceType = makeField 's' $ cleanTextValue (^. the @"sourceTypeName")+ alert :: Utf8Builder ()+ alert = F.forM_ (e ^. the @"alertType") $ \a -> do+ appendBS7 "|t:"+ appendBS7 $ case a of+ Z.Error -> "error"+ Z.Warning -> "warning"+ Z.Info -> "info"+ Z.Success -> "success"+ formatTags :: Utf8Builder ()+ formatTags = case e ^. the @"tags" of+ [] -> return ()+ ts -> do+ appendBS7 "|#"+ sequence_ $ intersperse (appendChar7 ',') $ map (^. the @"builder") ts++serviceCheck :: Text -- ^ name+ -> Z.ServiceCheckStatus+ -> Z.ServiceCheck+serviceCheck n s = Z.ServiceCheck n s Nothing Nothing Nothing []++-- | Convert an 'Event', 'Metric', or 'StatusCheck' to their wire format.+class ToStatsD a where+ toStatsD :: a -> Utf8Builder ()++instance ToStatsD Z.Metric where+ toStatsD = renderMetric++instance ToStatsD Z.Event where+ toStatsD = renderEvent++instance ToStatsD Z.ServiceCheck where+ toStatsD check = do+ appendBS7 "_sc|"+ appendText $ cleanMetricText $ check ^. the @"name"+ appendChar7 '|'+ appendDecimalSignedInt $ fromEnum $ check ^. the @"status"+ F.forM_ (check ^. the @"message") $ \msg ->+ appendBS7 "|m:" >> appendText (cleanMetricText msg)+ F.forM_ (check ^. the @"dateHappened") $ \ts -> do+ appendBS7 "|d:"+ appendDecimalSignedInt $ epochTime ts+ F.forM_ (check ^. the @"hostname") $ \hn ->+ appendBS7 "|h:" >> appendText (cleanMetricText hn)+ case check ^. the @"tags" of+ [] -> return ()+ ts -> do+ appendBS7 "|#"+ sequence_ $ intersperse (appendChar7 ',') $ map (^. the @"builder") ts++defaultSettings :: Z.DogStatsSettings+defaultSettings = Z.DogStatsSettings "127.0.0.1" 8125++createStatsClient :: MonadIO m+ => Z.DogStatsSettings+ -> Z.MetricName+ -> [Z.Tag]+ -> m Z.StatsClient+createStatsClient s n ts = liftIO $ do+ addrInfos <- getAddrInfo (Just $ defaultHints { addrFlags = [AI_PASSIVE] })+ (Just $ s ^. the @"host")+ (Just $ show $ s ^. the @"port")+ case addrInfos of+ [] -> error "No address for hostname" -- TODO throw+ (serverAddr:_) -> do+ sock <- socket (addrFamily serverAddr) Datagram defaultProtocol+ connect sock (addrAddress serverAddr)+ h <- socketToHandle sock WriteMode+ hSetBuffering h LineBuffering+ let builderAction work = do+ F.mapM_ (B.hPut h . runUtf8Builder) work+ return $ const Nothing+ reaperSettings = defaultReaperSettings { reaperAction = builderAction+ , reaperDelay = 1000000 -- one second+ , reaperCons = \item work -> Just $ maybe item (>> item) work+ , reaperNull = isNothing+ , reaperEmpty = Nothing+ }+ r <- mkReaper reaperSettings+ return $ Z.StatsClient h r n ts++closeStatsClient :: MonadIO m => Z.StatsClient -> m ()+closeStatsClient c = liftIO $ finalizeStatsClient c >> hClose (Z.handle c)++-- | 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 :: (MonadBase IO m, ToStatsD v) => Z.StatsClient -> v -> m ()+-- send Dummy _ = return ()+-- send (StatsClient _ r) v = liftBase $ reaperAdd r (toStatsD v >> appendChar7 '\n')+-- {-# INLINEABLE send #-}++tagged :: (HasType [Z.Tag] v) => (a -> v) -> (a -> [Z.Tag]) -> a -> v+tagged getVal getTag a = getVal a & typed @[Z.Tag] %~ (getTag a ++)+{-# INLINE tagged #-}++sampled' :: (HasType Z.SampleRate v) => (a -> v) -> (a -> Z.SampleRate) -> a -> v+sampled' getVal getRate a = getVal a & typed @Z.SampleRate .~ getRate a+{-# INLINE sampled' #-}++sampled :: (HasType Z.SampleRate v) => (a -> v) -> Z.SampleRate -> a -> v+sampled f r a = f a & typed @Z.SampleRate .~ r+{-# INLINE sampled #-}++incCounter :: Z.MetricName -> Z.Metric+incCounter n = metric n Z.Counter (1 :: Int)+{-# INLINE incCounter #-}++addCounter :: Z.MetricName -> (a -> Int) -> a -> Z.Metric+addCounter n f a = metric n Z.Counter (f a)+{-# INLINE addCounter #-}++gauge :: ToMetricValue v => Z.MetricName -> (a -> v) -> a -> Z.Metric+gauge n f a = metric n Z.Gauge (f a)+{-# INLINE gauge #-}++timer :: ToMetricValue v => Z.MetricName -> (a -> v) -> a -> Z.Metric+timer n f a = metric n Z.Timer (f a)+{-# INLINE timer #-}++histogram :: ToMetricValue v => Z.MetricName -> (a -> v) -> a -> Z.Metric+histogram n f a = metric n Z.Histogram (f a)+{-# INLINE histogram #-}++send ::+ ( MonadIO m+ , ToStatsD v+ , HasType Z.MetricName v+ , HasType [Z.Tag] v)+ => Z.StatsClient+ -> v+ -> m ()+send Z.Dummy _ = return ()+send (Z.StatsClient _ r n ts) v = liftIO $+ reaperAdd r ((toStatsD . addAspect n . addTags ts) v >> appendChar7 '\n')+{-# INLINEABLE send #-}++sendEvt :: (MonadIO m) => Z.StatsClient -> Z.Event -> m ()+sendEvt Z.Dummy _ = return ()+sendEvt (Z.StatsClient _ r (Z.MetricName n) ts) e = liftIO $+ reaperAdd r ((toStatsD . addTags (tag "aspect" n : ts)) e >> appendChar7 '\n')++sendSampled ::+ ( MonadIO m+ , ToStatsD v+ , HasType Z.SampleRate v+ , HasType Z.MetricName v+ , HasType [Z.Tag] v)+ => Z.StatsClient+ -> v+ -> m ()+sendSampled Z.Dummy _ = return ()+sendSampled c v = liftIO $ do+ z <- Z.SampleRate <$> randomIO+ when (z <= v ^. typed @Z.SampleRate) $ send c v+{-# INLINEABLE sendSampled #-}++envTag :: Z.EnvVarName -> Z.TagKey -> IO (Maybe Z.Tag)+envTag var key = do+ mbVal <- lookupEnv var+ return $ (tag key . T.pack) <$> mbVal++finalizeStatsClient :: Z.StatsClient -> IO ()+finalizeStatsClient (Z.StatsClient h r _ _) = reaperStop r >>= F.mapM_ (B.hPut h . runUtf8Builder)+finalizeStatsClient Z.Dummy = return ()++addAspect :: (HasType Z.MetricName v) => Z.MetricName -> v -> v+addAspect (Z.MetricName a) v =+ if T.null a+ then v+ else v & typed @Z.MetricName %~ (\(Z.MetricName n) -> Z.MetricName (a <> "." <> n))+{-# INLINE addAspect #-}++addTags :: (HasType [Z.Tag] v) => [Z.Tag] -> v -> v+addTags [] v = v+addTags ts v = v & typed @[Z.Tag] %~ (ts ++)+{-# INLINE addTags #-}
+ src/Arbor/Network/StatsD/Internal/Lens.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE ConstraintKinds #-}++module Arbor.Network.StatsD.Internal.Lens where++import qualified Data.Generics.Product.Fields as GL++type HasField'' n st ab = GL.HasField n st st ab ab
+ src/Arbor/Network/StatsD/Monad.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module Arbor.Network.StatsD.Monad where++import Arbor.Network.StatsD.Datadog+import Control.Monad.Except+import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Resource++class (Functor m, Applicative m, MonadIO m) => MonadStats m where+ getStatsClient :: m StatsClient++instance MonadStats m => MonadStats (ExceptT e m) where+ getStatsClient = lift getStatsClient++instance MonadStats m => MonadStats (IdentityT m) where+ getStatsClient = lift getStatsClient++instance MonadStats m => MonadStats (MaybeT m) where+ getStatsClient = lift getStatsClient++instance MonadStats m => MonadStats (ReaderT e m) where+ getStatsClient = lift getStatsClient++instance MonadStats m => MonadStats (ResourceT m) where+ getStatsClient = lift getStatsClient++instance MonadStats m => MonadStats (StateT s m) where+ getStatsClient = lift getStatsClient++sendMetric :: MonadStats m => Metric -> m ()+sendMetric m = getStatsClient >>= flip sendSampled m++sendEvent :: MonadStats m => Event -> m ()+sendEvent e = getStatsClient >>= flip sendEvt e
+ src/Arbor/Network/StatsD/Type.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}++module Arbor.Network.StatsD.Type where++import Control.Reaper (Reaper)+import Data.BufferBuilder.Utf8+import Data.Text (Text)+import Data.Time.Clock (UTCTime)+import GHC.Generics+import Network (HostName)+import System.IO (Handle)++-- | 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+ { builder :: Utf8Builder ()+ } deriving (Generic)++newtype SampleRate = SampleRate Double+ deriving (Show, Eq, Ord, Generic)++newtype MetricName = MetricName+ { text :: Text+ } deriving (Show, Eq, Generic)++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.+ deriving (Show, Eq, Generic)++-- | 'Metric'+--+-- The fields accessible through corresponding lenses are:+--+-- * 'name' @::@ 'MetricName'+--+-- * 'sampleRate' @::@ 'Double'+--+-- * 'type'' @::@ 'MetricType'+--+-- * 'value' @::@ 'ToMetricValue' @a => a@+--+-- * 'tags' @::@ @[@'Tag'@]@+data Metric = Metric+ { name :: !MetricName+ , sampleRate :: {-# UNPACK #-} !SampleRate+ , type_ :: !MetricType+ , value :: !(Utf8Builder ())+ , tags :: ![Tag]+ } deriving (Generic)++data Priority = Low | Normal+ deriving (Generic)++data AlertType = Error | Warning | Info | Success+ deriving (Generic)++-- | '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+ { title :: {-# UNPACK #-} !Text+ , text :: {-# UNPACK #-} !Text+ , dateHappened :: !(Maybe UTCTime)+ , hostname :: !(Maybe Text)+ , aggregationKey :: !(Maybe Text)+ , priority :: !(Maybe Priority)+ , sourceTypeName :: !(Maybe Text)+ , alertType :: !(Maybe AlertType)+ , tags :: ![Tag]+ } deriving (Generic)+++data ServiceCheckStatus = ServiceOk | ServiceWarning | ServiceCritical | ServiceUnknown+ deriving (Read, Show, Eq, Ord, Enum, Generic)++-- | '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+ { name :: {-# UNPACK #-} !Text+ , status :: !ServiceCheckStatus+ , message :: !(Maybe Text)+ , dateHappened :: !(Maybe UTCTime)+ , hostname :: !(Maybe Text)+ , tags :: ![Tag]+ } deriving Generic++data DogStatsSettings = DogStatsSettings+ { host :: HostName -- ^ The hostname or IP of the DogStatsD server (default: 127.0.0.1)+ , port :: Int -- ^ The port that the DogStatsD server is listening on (default: 8125)+ } deriving Generic++-- | Note that Dummy is not the only constructor, just the only publicly available one.+data StatsClient = StatsClient+ { handle :: !Handle+ , reaper :: Reaper (Maybe (Utf8Builder ())) (Utf8Builder ())+ , aspect :: MetricName+ , tags :: [Tag]+ }+ | Dummy -- ^ Just drops all stats.+ deriving Generic++type EnvVarName = String+type TagKey = Text
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}