packages feed

datadog 0.1.0.1 → 0.2.0.0

raw patch · 21 files changed

+2033/−433 lines, 21 filesdep +Cabaldep +datadogdep +dlistdep ~aesondep ~basedep ~buffer-buildernew-uploader

Dependencies added: Cabal, datadog, dlist, exceptions, hspec, http-client, http-client-tls, http-types, random, unordered-containers, vector

Dependency ranges changed: aeson, base, buffer-builder, monad-control

Files

datadog.cabal view
@@ -1,40 +1,101 @@--- Initial datadog.cabal generated by cabal init.  For further --- documentation, see http://haskell.org/cabal/users-guide/+-- This file has been generated from package.yaml by hpack version 0.17.1.+--+-- see: https://github.com/sol/hpack -name:                datadog-version:             0.1.0.1-synopsis:            Datadog client for Haskell. Currently only StatsD supported, other support forthcoming.--- description:         -homepage:            https://github.com/iand675/datadog-license:             MIT-license-file:        LICENSE-author:              Ian Duncan-maintainer:          ian@iankduncan.com--- copyright:           -category:            Network-build-type:          Simple--- extra-source-files:  -cabal-version:       >=1.10+name:           datadog+version:        0.2.0.0+synopsis:       Datadog client for Haskell. Supports both the HTTP API and StatsD.+category:       Network+homepage:       https://github.com/iand675/datadog+author:         Ian Duncan+maintainer:     ian@iankduncan.com+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10  library-  exposed-modules:     Network.Datadog.StatsD-                       -- Datadog.Metrics,-                       -- Datadog,-                       -- Datadog.Wai-  -- other-modules:       -  other-extensions:    OverloadedStrings, GeneralizedNewtypeDeriving, TemplateHaskell, FunctionalDependencies, MultiParamTypeClasses, FlexibleInstances-  build-depends:       base >=4.7 && <5,-                       aeson >=0.8 && <0.10,-                       lens,-                       bytestring,-                       time,-                       text,-                       old-locale,-                       buffer-builder ==0.2.*,-                       auto-update,-                       network,-                       monad-control ==1.*,-                       lifted-base,-                       transformers-base-  hs-source-dirs:      src-  default-language:    Haskell2010+  hs-source-dirs:+      src+  default-extensions: ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NoMonomorphismRestriction OverloadedStrings PackageImports PolyKinds QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies TypeOperators ViewPatterns+  ghc-options: -Wall -fwarn-tabs -O2+  build-depends:+      aeson+    , auto-update+    , base >= 4.7 && < 5+    , buffer-builder+    , bytestring+    , dlist+    , http-client+    , http-client-tls+    , http-types+    , lens+    , lifted-base+    , monad-control+    , network+    , old-locale+    , text+    , time+    , transformers-base+    , unordered-containers+    , vector+  exposed-modules:+      Network.Datadog+      Network.Datadog.Check+      Network.Datadog.Downtime+      Network.Datadog.Event+      Network.Datadog.Host+      Network.Datadog.Internal+      Network.Datadog.Lens+      Network.Datadog.Metrics+      Network.Datadog.Monitor+      Network.Datadog.Types+      Network.StatsD.Datadog+  default-language: Haskell2010++test-suite datadog-api-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  default-extensions: ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NoMonomorphismRestriction OverloadedStrings PackageImports PolyKinds QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies TypeOperators ViewPatterns+  ghc-options: -Wall -fwarn-tabs -O2+  build-depends:+      aeson+    , auto-update+    , base >= 4.7 && < 5+    , buffer-builder+    , bytestring+    , dlist+    , http-client+    , http-client-tls+    , http-types+    , lens+    , lifted-base+    , monad-control+    , network+    , old-locale+    , text+    , time+    , transformers-base+    , unordered-containers+    , vector+    , base+    , Cabal+    , exceptions+    , hspec+    , network+    , lens+    , random+    , text+    , time+    , datadog+  other-modules:+      Test.Network.Datadog+      Test.Network.Datadog.Check+      Test.Network.Datadog.Downtime+      Test.Network.Datadog.Event+      Test.Network.Datadog.Host+      Test.Network.Datadog.Monitor+      Test.Network.Datadog.StatsD+  default-language: Haskell2010
+ src/Network/Datadog.hs view
@@ -0,0 +1,65 @@+{-|+<https://datadoghq.com Datadog> is a monitoring service for IT, Operations and+Development teams who write and run applications at scale, and want to turn the+massive amounts of data produced by their apps, tools and services into+actionable insight.+-}+module Network.Datadog+( Keys(..)+, loadKeysFromEnv+, Environment+, createEnvironment+, withDatadog+, writeCredentials+, readWriteCredentials+, module Network.Datadog.Check+, module Network.Datadog.Downtime+, module Network.Datadog.Event+, module Network.Datadog.Host+, module Network.Datadog.Metrics+, module Network.Datadog.Monitor+) where+++import qualified Data.Text as T+import           Data.Text.Encoding (encodeUtf8)++import Network.HTTP.Client (newManager, withManager)+import Network.HTTP.Client.TLS (tlsManagerSettings)++import System.Environment (getEnv)++import Network.Datadog.Check+import Network.Datadog.Downtime+import Network.Datadog.Event+import Network.Datadog.Host+import Network.Datadog.Metrics+import Network.Datadog.Monitor+import Network.Datadog.Internal++-- | Load Datadog keys from environment variables.+--+-- The keys will be read from the enviornment variables+-- `DATADOG_API_KEY` and `DATADOG_APP_KEY`. If the keys cannot be read, this+-- function will throw an 'IOException'.+loadKeysFromEnv :: IO Keys+loadKeysFromEnv = do+  api <- getEnv "DATADOG_API_KEY"+  app <- getEnv "DATADOG_APP_KEY"+  return $ Keys api app++-- | Create a new environment using authentication keys, defaulting to the+-- Datadog documented default API URL.+createEnvironment :: Keys -> IO Environment+createEnvironment keys = fmap (Environment keys "https://app.datadoghq.com/api/v1/") managerIO+  where managerIO = newManager tlsManagerSettings++withDatadog :: DatadogCredentials k => k -> (DatadogClient k -> IO a) -> IO a+withDatadog k f = withManager tlsManagerSettings $ \man -> f $ DatadogClient man k++writeCredentials :: T.Text -> Write+writeCredentials = Write . encodeUtf8++readWriteCredentials :: T.Text -> T.Text -> ReadWrite+readWriteCredentials r w = ReadWrite (encodeUtf8 w) (encodeUtf8 r)+
+ src/Network/Datadog/Check.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Checks allow users to post check statuses, for use with monitors.+-}+module Network.Datadog.Check+( CheckStatus(..)+, CheckResult(..)+, recordCheck+, HasStatus(..)+, HasHostName(..)+, HasCheck(..)+, HasTimestamp(..)+, HasTags(..)+, HasMessage(..)+, AsCheckStatus(..)+,+) where++import Control.Monad (void)+import Data.Aeson (encode)+import Network.HTTP.Types+import Network.Datadog.Internal++-- | Record the result of a check in Datadog.+recordCheck :: Environment -> CheckResult -> IO ()+recordCheck env checkResult =+  let path = "check_run"+  in void $ datadogHttp env path [] POST $ Just $ encode checkResult+
+ src/Network/Datadog/Downtime.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Downtime prevents all alerting related to specific Datadog scopes.+-}+module Network.Datadog.Downtime+( DowntimeSpec(..)+, Downtime+, minimalDowntimeSpec+, scheduleDowntime+, updateDowntime+, cancelDowntime+, loadDowntime+, loadDowntimes+, HasScope(..)+, HasSpec(..)+, HasMessage(..)+, HasStart(..)+, HasEnd(..)+, HasId'(..)+, DowntimeId+) where+++import Control.Monad (void)+import Data.Aeson+import Network.HTTP.Types+import Network.Datadog.Internal++-- | Creates the most basic possible downtime specification, which just+-- contains the scope to which the downtime applies.+minimalDowntimeSpec :: Tag -> DowntimeSpec+minimalDowntimeSpec = DowntimeSpec Nothing Nothing Nothing++-- | Schedule a new downtime in Datadog.+scheduleDowntime :: Environment -> DowntimeSpec -> IO Downtime+scheduleDowntime env dspec =+  let path = "downtime"+  in datadogHttp env path [] POST (Just $ encode dspec) >>=+     decodeDatadog "scheduleDowntime"+++-- | Update the specification of a downtime in Datadog.+updateDowntime :: Environment -> DowntimeId -> DowntimeSpec -> IO Downtime+updateDowntime env did dspec =+  let path = "downtime/" ++ show did+  in datadogHttp env path [] PUT (Just $ encode dspec) >>=+     decodeDatadog "updateDowntime"+++-- | Cancel scheduled downtime in Datadog.+cancelDowntime :: Environment -> DowntimeId -> IO ()+cancelDowntime env downtimeId =+  let path = "downtime/" ++ show downtimeId+  in void $ datadogHttp env path [] DELETE Nothing+++-- | Load a scheduled downtime from Datadog by its ID.+loadDowntime :: Environment -> DowntimeId -> IO Downtime+loadDowntime env downtimeId =+  let path = "downtime/" ++ show downtimeId+  in datadogHttp env path [] GET Nothing >>=+     decodeDatadog "loadDowntime"+++-- | Load all scheduled downtimes, optionally filtering for only downtimes that+-- are currently active.+loadDowntimes :: Environment -> Bool -> IO [Downtime]+loadDowntimes env active =+  let path = "downtime"+      q = [("current_only", "true") | active]+  in datadogHttp env path q GET Nothing >>=+     decodeDatadog "loadDowntimes"
+ src/Network/Datadog/Event.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Events in Datadog represent notable occurrences.+-}+module Network.Datadog.Event+( EventPriority(..)+, AlertType(..)+, SourceType(..)+, EventSpec(..)+, Event(eventId', eventDetails)+, EventId+, minimalEventSpec+, createEvent+, loadEvent+, loadEvents+, AsEventPriority(..)+, AsAlertType(..)+, AsSourceType(..)+, HasTitle(..)+, HasText(..)+, HasPriority(..)+, HasDateHappened(..)+, HasAlertType(..)+, HasDetails(..)+, HasTags(..)+, HasSourceType(..)+, HasHost(..)+, HasId'(..)+) where+++import Control.Monad (liftM)++import Data.Aeson hiding (Error, Success)+-- import qualified Data.Aeson (Result(Success))+import Data.List (intercalate)+import Data.Text (Text)+import Data.Time.Clock+import Data.Time.Clock.POSIX++import Network.HTTP.Types++import Network.Datadog.Internal++-- | Creates the most basic description required for an event, containing the+-- event title, descriptive text, time of occurrence, and priority of the+-- event. This event will be of type Info.+minimalEventSpec :: Text -> Text -> UTCTime -> EventPriority -> EventSpec+minimalEventSpec specTitle specText time eventPriority = EventSpec+  { eventSpecTitle = specTitle+  , eventSpecText = specText+  , eventSpecDateHappened = time+  , eventSpecPriority = eventPriority+  , eventSpecHost = Nothing+  , eventSpecTags = []+  , eventSpecAlertType = Info+  , eventSpecSourceType = Nothing+  }+++-- | Store a new event in Datadog.+createEvent :: Environment -> EventSpec -> IO Event+createEvent env eventSpec =+  let path = "events"+  in liftM wrappedEvent $+     datadogHttp env path [] POST (Just $ encode eventSpec) >>=+     decodeDatadog "createEvent"+++-- | Load an event from Datadog by its ID.+loadEvent :: Environment -> EventId -> IO Event+loadEvent env eventId =+  let path = "events/" ++ show eventId+  in liftM wrappedEvent $+     datadogHttp env path [] GET Nothing >>=+     decodeDatadog "loadEvent"++-- | Query Datadog for events within a specific time range.+loadEvents :: Environment+           -> (UTCTime,UTCTime)+           -- ^ The range within which to query for events+           -> Maybe EventPriority+           -- ^ Optionally filter results by a specific priority level+           -> [Text]+           -- ^ A list of tags to filter by+           -> IO [Event]+loadEvents env (startTime, endTime) resultPriority filterTags =+  let path = "events"+      q = prependMaybe (\a -> ("priority", show a)) resultPriority $+            prependBool (not $ null filterTags) ("tags", intercalate "," (map show filterTags))+            [("start", show (floor (utcTimeToPOSIXSeconds startTime) :: Integer))+            ,("end", show (floor (utcTimeToPOSIXSeconds endTime) :: Integer))+            ]+  in liftM wrappedEvents $+     datadogHttp env path q GET Nothing >>=+     decodeDatadog "loadEvent"+
+ src/Network/Datadog/Host.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Controls host muting in Datadog.+-}+module Network.Datadog.Host+( muteHost+, unmuteHost+) where+++import Control.Monad (void)++import Data.Aeson+import Data.Text (Text, unpack)+import Data.Time.Clock+import Data.Time.Clock.POSIX++import Network.HTTP.Types++import Network.Datadog.Internal+++muteHost :: Environment -> Text -> Maybe UTCTime -> Bool -> IO ()+-- ^ Do not allow alerts to trigger on a specific host+muteHost env hostname mtime override =+  let path = "host/" ++ unpack hostname ++ "/mute"+      q = [("override", "true") | override]+      body = object $+             prependMaybe (\a -> "end" .= (ceiling (utcTimeToPOSIXSeconds a) :: Integer)) mtime $+             prependBool override ("override" .= True)+             ["hostname" .= hostname]+  in void $ datadogHttp env path q POST $ Just $ encode body+++unmuteHost :: Environment -> Text -> IO ()+-- ^ Allow alerts to trigger on a specific host+unmuteHost env hostname =+  let path = "host/" ++ unpack hostname ++ "/unmute"+      body = object ["hostname" .= hostname]+  in void $ datadogHttp env path [] POST $ Just $ encode body
+ src/Network/Datadog/Internal.hs view
@@ -0,0 +1,365 @@+{-# LANGUAGE OverloadedStrings #-}+-- we infect all the other modules with instances from+-- this module, so they don't appear orphaned.+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Network.Datadog.Internal+( prependMaybe+, prependBool+, datadogHttp+, decodeDatadog+, baseRequest+, defaultMonitorOptions+, DatadogCredentials(..)+, module Network.Datadog.Lens+, module Network.Datadog.Types+) where++import Control.Arrow (first)+import Control.Exception+import Control.Lens hiding ((.=), cons)++import Data.Aeson hiding (Series, Success, Error)+import Data.Aeson.Types (modifyFailure, typeMismatch)+import qualified Data.ByteString.Lazy as LBS (ByteString, empty)+import qualified Data.DList as D+import qualified Data.HashMap.Strict as HM+import Data.Maybe+import Data.Text (Text, pack, append, splitAt, findIndex, cons)+import Data.Text.Lazy (unpack)+import Data.Text.Encoding (encodeUtf8)+import Data.Text.Lazy.Encoding (decodeUtf8)+import Data.Time.Clock+import Data.Time.Clock.POSIX+import Data.Vector ((!?))++import Network.HTTP.Client hiding (host)+import Network.HTTP.Types++import Network.Datadog.Types+import Network.Datadog.Lens+import Prelude hiding (splitAt)++prependMaybe :: (a -> b) -> Maybe a -> [b] -> [b]+prependMaybe f = maybe id ((:) . f)+++prependBool :: Bool -> b -> [b] -> [b]+prependBool p a = if p then (a :) else id+++datadogHttp :: Environment-> String -> [(String, String)] -> StdMethod -> Maybe LBS.ByteString -> IO LBS.ByteString+datadogHttp (Environment keys baseUrl manager) endpoint q httpMethod content = do+  initReq <- parseUrl $ baseUrl ++ endpoint+  let body = RequestBodyLBS $ fromMaybe LBS.empty content+      headers = [("Content-type", "application/json") | isJust content]+      apiQuery = [("api_key", apiKey keys)+                 ,("application_key", appKey keys)]+      fullQuery = map (\(a,b) -> (encodeUtf8 (pack a), Just (encodeUtf8 (pack b)))) $+                  apiQuery ++ q+      request = setQueryString fullQuery $+                initReq { method = renderStdMethod httpMethod+                        , requestBody = body+                        , requestHeaders = headers+                        }+  responseBody <$> httpLbs request manager+++decodeDatadog :: FromJSON a => String -> LBS.ByteString -> IO a+decodeDatadog funcname body = either (throwIO . AssertionFailed . failstring) return $+                              eitherDecode body+  where failstring e = "Datadog Library decoding failure in \"" ++ funcname +++                       "\": " ++ e ++ ": " ++ unpack (decodeUtf8 body)++baseRequest :: Request+baseRequest = fromJust $ parseUrl "https://app.datadoghq.com"++class DatadogCredentials s where+  signRequest :: s -> Request -> Request++instance DatadogCredentials Write where+  signRequest (Write k) = setQueryString [("api_key", Just k)]++instance DatadogCredentials ReadWrite where+  signRequest (ReadWrite w r) = setQueryString [("api_key", Just w), ("application_key", Just r)]++instance ToJSON DowntimeSpec where+  toJSON ds = object $+              prependMaybe (\a -> "start" .= (ceiling (utcTimeToPOSIXSeconds a) :: Integer)) (ds ^. start) $+              prependMaybe (\a -> "end" .= (floor (utcTimeToPOSIXSeconds a) :: Integer)) (ds ^. end)+              ["scope" .= (ds ^. scope)]++instance FromJSON DowntimeSpec where+  parseJSON (Object v) = modifyFailure ("DowntimeSpec: " ++) $+                         DowntimeSpec <$>+                         (maybe (return Nothing) (withScientific "Integer" (\t -> return (Just (posixSecondsToUTCTime (fromIntegral (floor t :: Integer)))))) =<< (v .:? "start")) <*>+                         (maybe (return Nothing) (withScientific "Integer" (\t -> return (Just (posixSecondsToUTCTime (fromIntegral (floor t :: Integer)))))) =<< (v .:? "end")) <*>+                         v .:? "message" .!= Nothing <*>+                         (withArray "Text" (\t -> maybe (fail "\"scope\" Array is too short") parseJSON (t !? 0)) =<< v .: "scope")+  parseJSON a = modifyFailure ("DowntimeSpec: " ++) $ typeMismatch "Object" a++instance ToJSON Tag where+  toJSON (KeyValueTag k v) = Data.Aeson.String $ k `append` (':' `cons` v)+  toJSON (LabelTag t) = Data.Aeson.String t++instance FromJSON Tag where+  parseJSON (String s) = return $+                         maybe (LabelTag s) (\i -> uncurry KeyValueTag (splitAt i s)) $+                         findIndex (==':') s+  parseJSON a = modifyFailure ("Tag: " ++) $ typeMismatch "String" a++instance ToJSON CheckStatus where+  toJSON CheckOk = Number 0+  toJSON CheckWarning = Number 1+  toJSON CheckCritical = Number 2+  toJSON CheckUnknown = Number 3++instance FromJSON CheckStatus where+  parseJSON (Number 0) = return CheckOk+  parseJSON (Number 1) = return CheckWarning+  parseJSON (Number 2) = return CheckCritical+  parseJSON (Number 3) = return CheckUnknown+  parseJSON (Number n) = fail $ "CheckStatus: Number \"" ++ show n ++ "\" is not a valid CheckStatus"+  parseJSON a = modifyFailure ("MonitorType: " ++) $ typeMismatch "Number" a++instance ToJSON CheckResult where+  toJSON cr = object $+              prependMaybe (\a -> "timestamp" .= (floor (utcTimeToPOSIXSeconds a) :: Integer)) (cr ^. timestamp) $+              prependMaybe (\a -> "message" .= a) (cr ^. message)+              ["check" .= (cr ^. check)+              ,"host_name" .= (cr ^. hostName)+              ,"status" .= (cr ^. status)+              ,"tags" .= (cr ^. tags)+              ]++instance FromJSON CheckResult where+  parseJSON (Object v) = modifyFailure ("CheckResult: " ++) $+                         CheckResult <$>+                         v .: "check" <*>+                         v .: "host_name" <*>+                         v .: "status" <*>+                         v .:? "timestamp" .!= Nothing <*>+                         v .:? "message" .!= Nothing <*>+                         v .: "tags" .!= []+  parseJSON a = modifyFailure ("CheckResult: " ++) $ typeMismatch "Object" a++instance ToJSON Downtime where+  toJSON downtime = Object $ HM.insert "id" (toJSON $ downtime ^. id') basemap+    where (Object basemap) = toJSON (downtime ^. spec)++instance FromJSON Downtime where+  parseJSON (Object v) = modifyFailure ("Downtime: " ++) $+                         Downtime <$> v .: "id" <*> parseJSON (Object v)+  parseJSON a = modifyFailure ("Downtime: " ++) $ typeMismatch "Object" a++instance ToJSON EventPriority where+  toJSON NormalPriority = Data.Aeson.String "normal"+  toJSON LowPriority = Data.Aeson.String "low"++instance FromJSON EventPriority where+  parseJSON (Data.Aeson.String "normal") = return NormalPriority+  parseJSON (Data.Aeson.String "low") = return LowPriority+  parseJSON (Data.Aeson.String s) = fail $ "EventPriority: String " ++ show s ++ " is not a valid EventPriority"+  parseJSON a = modifyFailure ("EventPriority: " ++) $ typeMismatch "String" a++instance ToJSON AlertType where+  toJSON Error = Data.Aeson.String "error"+  toJSON Warning = Data.Aeson.String "warning"+  toJSON Info = Data.Aeson.String "info"+  toJSON Success = Data.Aeson.String "success"++instance FromJSON AlertType where+  parseJSON (Data.Aeson.String "error") = return Error+  parseJSON (Data.Aeson.String "warning") = return Warning+  parseJSON (Data.Aeson.String "info") = return Info+  parseJSON (Data.Aeson.String "success") = return Success+  parseJSON (Data.Aeson.String s) = fail $ "AlertType: String " ++ show s ++ " is not a valid AlertType"+  parseJSON a = modifyFailure ("AlertType: " ++) $ typeMismatch "String" a++instance ToJSON SourceType where+  toJSON Nagios = Data.Aeson.String "nagios"+  toJSON Hudson = Data.Aeson.String "hudson"+  toJSON Jenkins = Data.Aeson.String "jenkins"+  toJSON User = Data.Aeson.String "user"+  toJSON MyApps = Data.Aeson.String "my apps"+  toJSON Feed = Data.Aeson.String "feed"+  toJSON Chef = Data.Aeson.String "chef"+  toJSON Puppet = Data.Aeson.String "puppet"+  toJSON Git = Data.Aeson.String "git"+  toJSON BitBucket = Data.Aeson.String "bitbucket"+  toJSON Fabric = Data.Aeson.String "fabric"+  toJSON Capistrano = Data.Aeson.String "capistrano"++instance FromJSON SourceType where+  parseJSON (Data.Aeson.String "nagios") = return Nagios+  parseJSON (Data.Aeson.String "hudson") = return Hudson+  parseJSON (Data.Aeson.String "jenkins") = return Jenkins+  parseJSON (Data.Aeson.String "user") = return User+  parseJSON (Data.Aeson.String "my apps") = return MyApps+  parseJSON (Data.Aeson.String "feed") = return Feed+  parseJSON (Data.Aeson.String "chef") = return Chef+  parseJSON (Data.Aeson.String "puppet") = return Puppet+  parseJSON (Data.Aeson.String "git") = return Git+  parseJSON (Data.Aeson.String "bitbucket") = return BitBucket+  parseJSON (Data.Aeson.String "fabric") = return Fabric+  parseJSON (Data.Aeson.String "capistrano") = return Capistrano+  parseJSON (Data.Aeson.String s) = fail $ "SourceType: String " ++ show s ++ " is not a valid SourceType"+  parseJSON a = modifyFailure ("SourceType: " ++) $ typeMismatch "String" a++instance ToJSON EventSpec where+  toJSON ed = object $+              prependMaybe (\a -> "host" .= a) (ed ^. host) $+              prependMaybe (\a -> "source_type_name" .= pack (show a)) (ed ^. sourceType)+              ["title" .= (ed ^. title)+              ,"text" .= (ed ^. text)+              ,"date_happened" .= (floor (utcTimeToPOSIXSeconds (ed ^. dateHappened)) :: Integer)+              ,"priority" .= pack (show (ed ^. priority))+              ,"alert_type" .= pack (show (ed ^. alertType))+              ,"tags" .= (ed ^. tags)+              ]++instance FromJSON EventSpec where+  parseJSON (Object v) = modifyFailure ("EventSpec: " ++) $+                         EventSpec <$>+                         v .: "title" <*>+                         v .: "text" <*>+                         (withScientific "Integer" (\t -> return (posixSecondsToUTCTime (fromIntegral (floor t :: Integer)))) =<< v .: "date_happened") <*>+                         v .: "priority" <*>+                         v .:? "host" .!= Nothing <*>+                         v .:? "tags" .!= [] <*>+                         v .:? "alert_type" .!= Info <*>+                         v .:? "source_type" .!= Nothing+  parseJSON a = modifyFailure ("EventSpec: " ++) $ typeMismatch "Object" a++instance ToJSON Event where+  toJSON event = Object $ HM.insert "id" (toJSON (event ^. id')) basemap+    where (Object basemap) = toJSON (event ^. details)++instance FromJSON Event where+  parseJSON (Object v) = modifyFailure ("Event: " ++) $+                         Event <$> v .: "id" <*> parseJSON (Object v)+  parseJSON a = modifyFailure ("Event: " ++) $ typeMismatch "Object" a+++instance FromJSON WrappedEvent where+  parseJSON (Object v) = modifyFailure ("WrappedEvent: " ++) $+                         WrappedEvent <$> v .: "event"+  parseJSON a = modifyFailure ("WrappedEvent: " ++) $ typeMismatch "Object" a+++instance FromJSON WrappedEvents where+  parseJSON (Object v) = modifyFailure ("WrappedEvents: " ++) $+                         WrappedEvents <$> v .: "events"+  parseJSON a = modifyFailure ("WrappedEvents: " ++) $ typeMismatch "Object" a++instance ToJSON Series where+  toJSON s = object [ "series" .= D.toList (fromSeries s) ]++instance ToJSON Timestamp where+  toJSON = toJSON . (round :: NominalDiffTime -> Int) . fromTimestamp++instance ToJSON MetricPoints where+  toJSON (Gauge   ps) = toJSON $ fmap (first Timestamp) ps+  toJSON (Counter ps) = toJSON $ fmap (first Timestamp) ps++instance ToJSON Metric where+  toJSON m = object ks+    where+      f = maybe id (\x y -> ("host" .= x) : y) $ metricHost m+      ks = f [ "metric" .= metricName m+             , "points" .= metricPoints m+             , "tags"   .= metricTags m+             , "type"   .= case metricPoints m of+                 Gauge _   -> "gauge"   :: Text+                 Counter _ -> "counter" :: Text+             ]++instance ToJSON MonitorType where+  toJSON MetricAlert = Data.Aeson.String "metric alert"+  toJSON ServiceCheck = Data.Aeson.String "service check"+  toJSON EventAlert = Data.Aeson.String "event alert"++instance FromJSON MonitorType where+  parseJSON (Data.Aeson.String "metric alert") = return MetricAlert+  -- TODO figure out what "query alert" actually is+  parseJSON (Data.Aeson.String "query alert") = return MetricAlert+  parseJSON (Data.Aeson.String "service check") = return ServiceCheck+  parseJSON (Data.Aeson.String "event alert") = return EventAlert+  parseJSON (Data.Aeson.String s) = fail $ "MonitorType: String " ++ show s ++ " is not a valid MonitorType"+  parseJSON a = modifyFailure ("MonitorType: " ++) $ typeMismatch "String" a++instance ToJSON MonitorOptions where+  toJSON opts = Object $ HM.fromList [ ("silenced", toJSON (opts ^. silenced))+                                     , ("notify_no_data", Bool (opts ^. notifyNoData))+                                     , ("no_data_timeframe", maybe Null (Number . fromIntegral) (opts ^. noDataTimeframe))+                                     , ("timeout_h", maybe Null (Number . fromIntegral) (opts ^. timeoutH))+                                     , ("renotify_interval", maybe Null (Number . fromIntegral) (opts ^. renotifyInterval))+                                     , ("escalation_message", Data.Aeson.String (opts ^. escalationMessage))+                                     , ("notify_audit", Bool (opts ^. notifyAudit))+                                     ]++instance FromJSON MonitorOptions where+  parseJSON (Object v) = modifyFailure ("MonitorOptions: " ++) $+                         MonitorOptions <$>+                         v .:? "silenced" .!= HM.empty <*>+                         v .:? "notify_no_data" .!= False <*>+                         v .:? "no_data_timeframe" .!= Nothing <*>+                         v .:? "timeout_h" .!= Nothing <*>+                         v .:? "renotify_interval" .!= Nothing <*>+                         v .:? "escalation_message" .!= "" <*>+                         v .:? "notify_audit" .!= False+  parseJSON a = modifyFailure ("MonitorOptions: " ++) $ typeMismatch "Object" a++instance ToJSON MonitorSpec where+  toJSON ms = Object $ HM.insert "options" (toJSON (ms ^. options)) hmap+    where (Object hmap) = object $+                          prependMaybe ("name" .=) (ms ^. name) $+                          prependMaybe ("message" .=) (ms ^. message)+                          [ "type" .= pack (show (ms ^. type'))+                          , "query" .= (ms ^. query)+                          ]++-- | Creates the most basic specification required by a monitor, containing the+-- type of monitor and the query string used to detect the monitor's state.+--+-- Generates a set of "default" Monitor options, which specify as little+-- optional configuration as possible.  This includes:+--+--   * No silencing of any part of the monitor+--   * No notification when data related to the monitor is missing+--   * No alert timeout after the monitor is triggeredn+--   * No renotification when the monitor is triggered+--   * No notification when the monitor is modified+--+-- In production situations, it is /not safe/ to rely on this documented+-- default behaviour for critical setitngs; use the helper functions to+-- introspect the MonitorOptions instance provided by this function. This also+-- protects against future modifications to this API.+defaultMonitorOptions :: MonitorOptions+defaultMonitorOptions = MonitorOptions { monitorOptionsSilenced = HM.empty+                                       , monitorOptionsNotifyNoData = False+                                       , monitorOptionsNoDataTimeframe = Nothing+                                       , monitorOptionsTimeoutH = Nothing+                                       , monitorOptionsRenotifyInterval = Nothing+                                       , monitorOptionsEscalationMessage = ""+                                       , monitorOptionsNotifyAudit = False+                                       }++instance FromJSON MonitorSpec where+  parseJSON (Object v) = modifyFailure ("MonitorSpec: " ++) $+                         MonitorSpec <$>+                         v .: "type" <*>+                         v .: "query" <*>+                         v .:? "name" .!= Nothing <*>+                         v .:? "message" .!= Nothing <*>+                         v .:? "options" .!= defaultMonitorOptions+  parseJSON a = modifyFailure ("MonitorSpec: " ++) $ typeMismatch "Object" a++instance ToJSON Monitor where+  toJSON monitor = Object $ HM.insert "id" (toJSON (monitor ^. id')) basemap+    where (Object basemap) = toJSON (monitor ^. spec)++instance FromJSON Monitor where+  parseJSON (Object v) = modifyFailure ("Monitor: " ++ ) $+                         Monitor <$> v .: "id" <*> parseJSON (Object v)+  parseJSON a = modifyFailure ("Monitor: " ++) $ typeMismatch "Object" a
+ src/Network/Datadog/Lens.hs view
@@ -0,0 +1,24 @@+{-# OPTIONS_HADDOCK prune #-}+{-# LANGUAGE FunctionalDependencies #-}+module Network.Datadog.Lens where++import Control.Lens.TH (makeClassyPrisms, makeFields)++import Network.Datadog.Types++makeFields ''CheckResult+makeFields ''DowntimeSpec+makeFields ''Downtime+makeFields ''EventSpec+makeFields ''Event+makeFields ''Metric+makeFields ''MonitorOptions+makeFields ''MonitorSpec+makeFields ''Monitor+makeClassyPrisms ''Tag+makeClassyPrisms ''CheckStatus+makeClassyPrisms ''EventPriority+makeClassyPrisms ''AlertType+makeClassyPrisms ''SourceType+makeClassyPrisms ''MetricPoints+makeClassyPrisms ''MonitorType
+ src/Network/Datadog/Metrics.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Network.Datadog.Metrics+  ( Series (..)+  , Metric (..)+  , MetricPoints (..)+  , sendMetrics+  , series+  , HasName(..)+  , HasPoints(..)+  , HasTags(..)+  , HasHost(..)+  , AsMetricPoints(..)+  ) where+import Control.Monad (void)+import Data.Aeson hiding (Series)+import Data.DList+import qualified Network.HTTP.Types  as HTTP+import qualified Network.HTTP.Client as C+import Network.Datadog.Internal++series :: [Metric] -> Series+series = Series . fromList++metricRequest :: C.Request+metricRequest = baseRequest { C.method = HTTP.methodPost+                            , C.path = "/api/v1/series"+                            , C.requestHeaders = [("Content-Type", "application/json")]+                            }++sendMetrics :: DatadogCredentials k => DatadogClient k -> Series -> IO ()+sendMetrics m s = void $ C.httpNoBody req $ datadogClientManager m+  where+    req = (signRequest (datadogClientKeys m) metricRequest) { C.requestBody = C.RequestBodyLBS $ encode s }++-- | Wall clock time+{-+withTimingMetric :: DatadogCredentials k => DatadogClient k+                 -> (Metric -> IO ())+                 -> Text        -- ^ metric+                 -> Maybe Text  -- ^ hostname+                 -> [Text]      -- ^ tags+                 -> IO a+                 -> IO a+withTimingMetric mAction m h ts action = do+  t <- getCurrentTime+  r <- action+  t' <- getCurrentTime+  mAction $ Metric m [Counter diff]diffUTCTime t' t+-}
+ src/Network/Datadog/Monitor.hs view
@@ -0,0 +1,255 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Monitoring all of your infrastructure in one place wouldn’t be complete without+the ability to know when critical changes are occurring. Datadog gives you the+ability to create monitors that will actively check metrics, integration+availability, network endpoints and more. Once a monitor is created, you will+be notified when its conditions are met.++A simple way to get started with monitors:++> main = do+>   env <- createEnvironment =<< loadKeysFromEnv+>   -- Check if the average bytes received in the last five minutes is >100 on host0+>   let query = "avg(last_5m):sum:system.net.bytes_rcvd{host:host0} > 100"+>   let mspec = minimalMonitorSpec MetricAlert query+>   monitor <- createMonitor env mspec+>   print $ mId monitor+-}+module Network.Datadog.Monitor+( MonitorSpec(..)+, MonitorType(..)+, MonitorOptions(..)+, getSilencedMonitorScopes+, silenceMonitorScope+, unsilenceMonitorScope+, unsilenceAllMonitorScope+, doesNotifyOnNoMonitorData+, notifyOnNoMonitorData+, noNotifyOnNoMonitorData+, getMonitorTimeout+, setMonitorTimeout+, clearMonitorTimeout+, doesRenotifyMonitor+, renotifyMonitor+, noRenotifyMonitor+, doesNotifyOnAudit+, notifyOnAudit+, noNotifyOnAudit+, Monitor(..)+, MonitorId+, minimalMonitorSpec+, createMonitor+, updateMonitor+, deleteMonitor+, loadMonitor+, loadMonitors+, muteAllMonitors+, unmuteAllMonitors+, HasId'(..)+, HasSpec(..)+, HasType'(..)+, HasQuery(..)+, HasOptions(..)+, HasMessage(..)+, HasName(..)+, HasNotifyNoData(..)+, HasTimeoutH(..)+, HasRenotifyInterval(..)+, HasNoDataTimeframe(..)+, HasSilenced(..)+, AsMonitorType(..)+) where++import Control.Arrow+import Control.Exception+import Control.Lens+import Control.Monad (void)++import Data.Aeson+import qualified Data.HashMap.Strict as Data.HashMap+import Data.List (intercalate)+import Data.Maybe+import qualified Data.Text as T (Text, null)+import Data.Time.Clock+import Data.Time.Clock.POSIX++import Network.HTTP.Types++import Network.Datadog.Internal++-- | Provide a list of the silenced scopes for this monitor and the time at+-- which the silencer will expire (may be indefinite). The monitor @ "*" @+-- refers to the monitor at large (un-scoped).+getSilencedMonitorScopes :: MonitorOptions -> [(T.Text, Maybe UTCTime)]+getSilencedMonitorScopes opts = map (second (fmap (posixSecondsToUTCTime . fromIntegral))) $ Data.HashMap.toList $ opts ^. silenced++-- | Silence a given scope until some time (or indefinitely), replacing the+-- current silencer on the given scope if one already exists.+silenceMonitorScope :: T.Text -> Maybe UTCTime -> MonitorOptions -> MonitorOptions+silenceMonitorScope scopeName mtime old = old & silenced %~ silenceF+  where silenceF = Data.HashMap.insert scopeName (fmap (floor . utcTimeToPOSIXSeconds) mtime)++-- | Remove the silencer from a given scope, if the scope is currently+-- silenced.+unsilenceMonitorScope :: T.Text -> MonitorOptions -> MonitorOptions+unsilenceMonitorScope scopeName old = old & silenced %~ (Data.HashMap.delete scopeName)++-- | Unsilence every scope in the monitor, including the global scope.+unsilenceAllMonitorScope :: MonitorOptions -> MonitorOptions+unsilenceAllMonitorScope = set silenced Data.HashMap.empty++-- | Determine how long without data a monitor will go before notifying to+-- such, providing Nothing if the monitor will never notify on lack of data.+doesNotifyOnNoMonitorData :: MonitorOptions -> Maybe NominalDiffTime+doesNotifyOnNoMonitorData opts = if opts ^. notifyNoData+                                   then Just $ maybe (throw (AssertionFailed "Datadog Library internal error")) (fromIntegral . (*60)) $ opts ^. noDataTimeframe+                                   else Nothing++-- | Have the monitor notify when it does not receive data for some given+-- amount of time (rounded down to the nearest minute).+notifyOnNoMonitorData :: NominalDiffTime -> MonitorOptions -> MonitorOptions+notifyOnNoMonitorData difftime old = old & notifyNoData .~ True & noDataTimeframe ?~ stamp+  where stamp = floor (difftime / 60)++-- | Prevent the monitor from notifying when it is missing data.+noNotifyOnNoMonitorData :: MonitorOptions -> MonitorOptions+noNotifyOnNoMonitorData old = old & notifyNoData .~ False & noDataTimeframe .~ Nothing++-- | Determine after how long the monitor will stop alerting after it is+-- triggered, providing Nothing if the monitor will never stop alerting.+getMonitorTimeout :: MonitorOptions -> Maybe NominalDiffTime+getMonitorTimeout opts = (fromIntegral . (*3600)) <$> (opts ^. timeoutH)++-- | Have the monitor stop alerting some time after it is triggered (rounded up+-- to the nearest hour).+setMonitorTimeout :: NominalDiffTime -> MonitorOptions -> MonitorOptions+setMonitorTimeout difftime old = old & timeoutH ?~ stamp+  where stamp = ceiling (difftime / 3600)++-- | Prevent the monitor from timing out after it is triggered.+clearMonitorTimeout :: MonitorOptions -> MonitorOptions+clearMonitorTimeout = set timeoutH Nothing++-- | Determine after how long after being triggered the monitor will re-notify,+-- and what message it will include in the re-notification (if any), providing+-- Nothing if the monitor will never re-notify.+doesRenotifyMonitor :: MonitorOptions -> Maybe (NominalDiffTime,Maybe T.Text)+doesRenotifyMonitor opts = (\i -> (fromIntegral (i * 60), result)) <$> (opts ^. renotifyInterval)+  where msg = opts ^. escalationMessage+        result = if T.null msg then Nothing else Just msg++-- | Have the monitor re-notify some amount of time after the most recent+-- notification (rounded down to the nearest minute) and optionally what text+-- it will include in the re-notification.+renotifyMonitor :: NominalDiffTime -> Maybe T.Text -> MonitorOptions -> MonitorOptions+renotifyMonitor difftime mMessage old = old & renotifyInterval ?~ stamp & escalationMessage .~ msg+  where stamp = floor (difftime / 60)+        msg = fromMaybe "" mMessage++-- | Prevent the monitor from re-notifying after it triggers an un-resolved+-- notification.+noRenotifyMonitor :: MonitorOptions -> MonitorOptions+noRenotifyMonitor old = old & renotifyInterval .~ Nothing & escalationMessage .~ ""++-- | Determine if the monitor triggers a notification when it is modified.+doesNotifyOnAudit :: MonitorOptions -> Bool+doesNotifyOnAudit = view notifyAudit++-- | Have the monitor trigger a notification when it is modified.+notifyOnAudit :: MonitorOptions -> MonitorOptions+notifyOnAudit = set notifyAudit True++-- | Prevent the monitor from triggering a notification when it is modified.+noNotifyOnAudit :: MonitorOptions -> MonitorOptions+noNotifyOnAudit = set notifyAudit False+++-- | Creates the most basic specification required by a monitor, containing the+-- type of monitor and the query string used to detect the monitor's state.+--+-- This uses 'defaultMonitorOptions' to set the options (see that function for+-- disclaimer(s)).+minimalMonitorSpec :: MonitorType -> T.Text -> MonitorSpec+minimalMonitorSpec cmtype cmquery = MonitorSpec { monitorSpecType' = cmtype+                                                , monitorSpecQuery = cmquery+                                                , monitorSpecName = Nothing+                                                , monitorSpecMessage = Nothing+                                                , monitorSpecOptions = defaultMonitorOptions+                                                }++-- | Create a new monitor in Datadog matching a specification.+createMonitor :: Environment -> MonitorSpec -> IO Monitor+createMonitor env monitorspec =+  let path = "monitor"+  in datadogHttp env path [] POST (Just $ encode monitorspec) >>=+     decodeDatadog "createMonitor"+++-- | Load a monitor from Datadog by its ID.+loadMonitor :: Environment -> MonitorId -> IO Monitor+loadMonitor env monitorId =+  let path = "monitor/" ++ show monitorId+  in datadogHttp env path [] GET Nothing >>=+     decodeDatadog "loadMonitor"+++-- | Sync a monitor with Datadog.+--+-- This must be called on any active monitors to apply the changes with Datadog+-- itself; merely modifying a monitor locally is not enough to store the+-- changes.+--+-- /Beware/: If a monitor has changed on the Datadog remote endpoint between+-- the time it was copied locally and when this function is called, those+-- changes already made remotely will be overwritten by this change.+updateMonitor :: Environment -> MonitorId -> MonitorSpec -> IO Monitor+updateMonitor env monitorId mspec =+  let path = "monitor/" ++ show monitorId+  in datadogHttp env path [] PUT (Just $ encode mspec) >>=+     decodeDatadog "updateMonitor"+++-- | Delete a monitor from Datadog.+--+-- Note that once a monitor is deleted, it cannot be used locally anymore,+-- however you can always create a new monitor using the deleted monitor's+-- specification.+deleteMonitor :: Environment -> MonitorId -> IO ()+deleteMonitor env monitorId =+  let path = "monitor/" ++ show monitorId+  in void $ datadogHttp env path [] DELETE Nothing+++-- | Load monitors from Datadog.+--+-- This function takes a filter list argument, which should contain any tags+-- the user wishes to filter on.  If the filter list is left empty, no filters+-- will be applied.  The list of tags is ANDed together; if you specify more+-- than one filter tag, only metrics which match all filter tags will be+-- provided.+loadMonitors :: Environment+             -> [Tag]+             -- ^ Tags on which to filter the results+             -> IO [Monitor]+loadMonitors env filterTags =+  let path = "monitor"+      q = [("tags", intercalate "," (map show filterTags)) | not (null filterTags)]+  in datadogHttp env path q GET Nothing >>=+     decodeDatadog "loadMonitors"+++-- | Prevent all monitors from notifying indefinitely.+muteAllMonitors :: Environment -> IO ()+muteAllMonitors env =+  let path = "monitor/mute_all"+  in void $ datadogHttp env path [] POST Nothing+++-- | Allow all monitors to notify.+unmuteAllMonitors :: Environment -> IO ()+unmuteAllMonitors env =+  let path = "monitor/unmute_all"+  in void $ datadogHttp env path [] POST Nothing+
− src/Network/Datadog/StatsD.hs 
@@ -1,396 +0,0 @@-{-| 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 OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-module Network.Datadog.StatsD (-  -- * Client interface-  DogStatsSettings(..),-  defaultSettings,-  withDogStatsD,-  send,-  -- * Data supported by DogStatsD -  metric,-  Metric,-  MetricName(..),-  MetricType(..),-  event,-  Event,-  serviceCheck,-  ServiceCheck,-  ServiceCheckStatus(..),-  ToStatsD,-  -- * Optional fields-  Tag,-  tag,-  ToMetricValue,-  value,-  Priority(..),-  AlertType(..),-  HasName(..),-  HasSampleRate(..),-  HasType'(..),-  HasTags(..),-  HasTitle(..),-  HasText(..),-  HasDateHappened(..),-  HasHostname(..),-  HasAggregationKey(..),-  HasPriority(..),-  HasSourceTypeName(..),-  HasAlertType(..),-  HasHost(..),-  HasPort(..),-  HasStatus(..),-  HasMessage(..),-  -- * Dummy client-  StatsClient(Dummy)-) where-import Control.Applicative ((<$>))-import Control.Exception (bracket)-import Control.Lens-import Control.Monad.Base-import Control.Monad.Trans.Control-import Control.Reaper-import Data.BufferBuilder.Utf8-import Data.List (intersperse)-import Data.Monoid-import Data.Maybe (isNothing)-import Data.Int-import Data.Word-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.Time.Format-import Data.Text.Encoding (encodeUtf8)-import Data.ByteString.Short hiding (empty)-import Network.Socket hiding (send, sendTo, recv, recvFrom)-import System.IO (hClose, hSetBuffering, BufferMode(LineBuffering), IOMode(WriteMode), Handle)--epochTime :: UTCTime -> Int-epochTime = round . utcTimeToPOSIXSeconds--newtype MetricName = MetricName { fromMetricName :: Text }--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 #-}---- | 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 { fromTag :: Utf8Builder () }---- | 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 k v = Tag (build k >> appendChar7 ':' >> build v)-  where-    build = appendText . 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 = appendDecimalSignedInt--instance ToMetricValue Double where-  encodeValue = appendDecimalDouble---- | Smart 'Metric' constructor. Use the lens functions to set the optional fields.-metric :: (ToMetricValue a) => MetricName -> MetricType -> a -> Metric-metric n t v = Metric n 1 t (encodeValue v) []---- | 'Metric'------ The fields accessible through corresponding lenses are:------ * 'name' @::@ 'MetricName'------ * 'sampleRate' @::@ 'Double'------ * 'type'' @::@ 'MetricType'------ * 'value' @::@ 'ToMetricValue' @a => a@------ * 'tags' @::@ @[@'Tag'@]@-data Metric = Metric-  { metricName       :: !MetricName-  , metricSampleRate :: {-# UNPACK #-} !Double-  , metricType'      :: !MetricType-  , mValue           :: !(Utf8Builder ())-  , 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 = sets $ \f m -> m { mValue = encodeValue $ f $ mValue m }-{-# INLINE value #-}--renderMetric :: Metric -> Utf8Builder ()-renderMetric (Metric n sr t v ts) = do-  appendText $ cleanMetricText $ fromMetricName n-  appendChar7 ':'-  v-  appendChar7 '|'-  unit-  formatRate-  formatTags-  where-    unit = case t of-      Gauge     -> appendChar7 'g'-      Counter   -> appendChar7 'c'-      Timer     -> appendBS7 "ms"-      Histogram -> appendChar7 'h'-      Set       -> appendChar7 's'-    formatTags = case ts of-      [] -> return ()-      xs -> appendBS7 "|#" >> F.sequence_ (intersperse (appendChar7 ',') $ map fromTag xs)-    formatRate = if sr == 1 then return () else appendBS7 "|@" >> appendDecimalDouble 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 t d = Event t d Nothing Nothing Nothing Nothing Nothing 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-  { eventTitle          :: {-# UNPACK #-} !Text-  , eventText           :: {-# UNPACK #-} !Text-  , eventDateHappened   :: !(Maybe UTCTime)-  , eventHostname       :: !(Maybe Text)-  , eventAggregationKey :: !(Maybe Text)-  , eventPriority       :: !(Maybe Priority)-  , eventSourceTypeName :: !(Maybe Text)-  , eventAlertType      :: !(Maybe AlertType)-  , eventTags           :: ![Tag]-  }--makeFields ''Event--renderEvent :: 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 = encodeUtf8 $ escapeEventContents $ eventTitle e-    escapedText = encodeUtf8 $ escapeEventContents $ eventText e-    makeField c v = F.forM_ v $ \jv ->-      appendChar7 '|' >> appendChar7 c >> appendChar7 ':' >> jv-    cleanTextValue f = (appendText . cleanMetricText) <$> f e-    -- TODO figure out the actual format that dateHappened values are supposed to have.-    happened = F.forM_ (eventDateHappened e) $ \h -> do-      appendBS7 "|d:"-      appendDecimalSignedInt $ epochTime h-    formatHostname = makeField 'h' $ cleanTextValue eventHostname-    aggregation = makeField 'k' $ cleanTextValue eventAggregationKey-    formatPriority = F.forM_ (eventPriority e) $ \p -> do-      appendBS7 "|p:"-      appendBS7 $ case p of-        Low    -> "low"-        Normal -> "normal"-    sourceType = makeField 's' $ cleanTextValue eventSourceTypeName-    alert = F.forM_ (eventAlertType e) $ \a -> do-              appendBS7 "|t:"-              appendBS7 $ case a of-                Error   -> "error"-                Warning -> "warning"-                Info    -> "info"-                Success -> "success"-    formatTags = case eventTags e of-      [] -> return ()-      ts -> do-        appendBS7 "|#"-        sequence_ $ intersperse (appendChar7 ',') $ map fromTag ts--data ServiceCheckStatus = ServiceOk | ServiceWarning | ServiceCritical | ServiceUnknown-  deriving (Read, Show, Eq, Ord, 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-  { serviceCheckName         :: {-# UNPACK #-} !Text-  , serviceCheckStatus       :: !ServiceCheckStatus-  , serviceCheckMessage      :: !(Maybe Text)-  , serviceCheckDateHappened :: !(Maybe UTCTime)-  , serviceCheckHostname     :: !(Maybe Text)-  , serviceCheckTags         :: ![Tag]-  }--makeFields ''ServiceCheck--serviceCheck :: Text -- ^ name-             -> ServiceCheckStatus-             -> ServiceCheck-serviceCheck n s = 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 Metric where-  toStatsD = renderMetric--instance ToStatsD Event where-  toStatsD = renderEvent--instance ToStatsD ServiceCheck where-  toStatsD check = do-    appendBS7 "_sc|"-    appendText $ cleanMetricText $ check ^. name-    appendChar7 '|'-    appendDecimalSignedInt $ fromEnum $ check ^. status-    F.forM_ (check ^. message) $ \msg ->-      appendBS7 "|m:" >> appendText (cleanMetricText msg)-    F.forM_ (check ^. dateHappened) $ \ts -> do-      appendBS7 "|d:"-      appendDecimalSignedInt $ epochTime ts-    F.forM_ (check ^. hostname) $ \hn ->-      appendBS7 "|h:" >> appendText (cleanMetricText hn)-    case check ^. tags of-      [] -> return ()-      ts -> do-        appendBS7 "|#"-        sequence_ $ intersperse (appendChar7 ',') $ map fromTag ts--data DogStatsSettings = DogStatsSettings-  { dogStatsSettingsHost     :: HostName -- ^ The hostname or IP of the DogStatsD server (default: 127.0.0.1)-  , dogStatsSettingsPort     :: Int      -- ^ The port that the DogStatsD server is listening on (default: 8125)-  }--makeFields ''DogStatsSettings--defaultSettings :: DogStatsSettings-defaultSettings = DogStatsSettings "127.0.0.1" 8125--withDogStatsD :: MonadBaseControl IO m => DogStatsSettings -> (StatsClient -> m a) -> m a-withDogStatsD s f = do-     let setup = do-           addrInfos <- getAddrInfo (Just $ defaultHints { addrFlags = [AI_PASSIVE] })-                                    (Just $ s ^. host)-                                    (Just $ show $ s ^. 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 $ StatsClient h r-     liftBaseOp (bracket setup (\c -> finalizeStatsClient c >> hClose (statsClientHandle c))) f---- | Note that Dummy is not the only constructor, just the only publicly available one.-data StatsClient = StatsClient-                   { statsClientHandle :: !Handle-                   , statsClientReaper :: Reaper (Maybe (Utf8Builder ())) (Utf8Builder ())-                   }-                 | 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 :: (MonadBase IO m, ToStatsD v) => StatsClient -> v -> m ()-send (StatsClient _ r) v = liftBase $ reaperAdd r (toStatsD v >> appendChar7 '\n')-send Dummy _ = return ()-{-# INLINEABLE send #-}--finalizeStatsClient :: StatsClient -> IO ()-finalizeStatsClient (StatsClient h r) = reaperStop r >>= F.mapM_ (B.hPut h . runUtf8Builder)-finalizeStatsClient Dummy = return ()-
+ src/Network/Datadog/Types.hs view
@@ -0,0 +1,280 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE TemplateHaskell            #-}+module Network.Datadog.Types where+import           Data.ByteString.Char8 (ByteString)+import           Data.DList (DList)+import           Data.HashMap.Strict (HashMap)+import           Data.Text (Text)+import qualified Data.Text as T+import           Data.Int (Int64)+import           Data.Time.Clock (UTCTime, NominalDiffTime)+import           Data.Time.Clock.POSIX (POSIXTime)+import           Network.HTTP.Client (Manager)++newtype Timestamp = Timestamp { fromTimestamp :: NominalDiffTime }++newtype Write = Write { writeApiKey :: ByteString }++data ReadWrite = ReadWrite { readWriteApiKey :: ByteString+                           , readWriteApplicationKey :: ByteString+                           }++data DatadogClient a = DatadogClient+  { datadogClientManager        :: Manager+  , datadogClientKeys           :: a+  }+++-- | Wraps the keys needed by Datadog to fully access the API.+data Keys = Keys { apiKey :: String+                   -- A write-key associated with a user+                 , appKey :: String+                   -- A read-key associated with an application+                 } deriving (Eq)+++-- | An Environment contains everything needed to interact with Datadog.+data Environment = Environment { environmentKeys :: Keys+                                 -- ^ Auth keys to permit communication with Datadog+                               , environmentApiUrl :: String+                                 -- ^ The root URL for the Datadog API+                               , environmentManager :: Manager+                                 -- ^ HTTP manager used to make requests to Datadog+                               }++-- | Entity descriptor.+--+-- Entities in Datadog (hosts, metrics, events, etc) are frequently associated+-- with one more more "tags". These tags are labels that identify an entity as+-- belonging to a particular group or having particular properties. A tag can+-- come in two forms: a simple text label, describing entities associated with+-- the tag, or a key-value pair, associating entities with a specific slice of+-- a larger categorization.+--+-- As strings, the key and value parts of a key-value pair are separated by a+-- (':'). As such, any tag with no colons is a label, and any tag with one (or+-- more) is a key-value pair - if more than one ':' is specified, the+-- additional ':'s will become part of the value.+data Tag = KeyValueTag Text Text+         | LabelTag Text+         deriving (Eq)++instance Show Tag where+  show (KeyValueTag k v) = T.unpack k ++ (':' : T.unpack v)+  show (LabelTag t) = T.unpack t++instance Read Tag where+  readsPrec _ s = let t = T.pack s+                  in (\a -> [(a, "")]) $+                     maybe (LabelTag t) (\i -> uncurry KeyValueTag (T.splitAt i t)) $+                     T.findIndex (==':') t++-- | The status of a service, based on a check that is run against it.+data CheckStatus = CheckOk+                   -- ^ Everything is as it should be.+                 | CheckWarning+                   -- ^ Something abnormal, but not critical, is amiss.+                 | CheckCritical+                   -- ^ Something dangerously critical is amiss.+                 | CheckUnknown+                   -- ^ The current status cannot be determined.+                 deriving (Eq)++-- | The result of running a check on some service.+data CheckResult = CheckResult { checkResultCheck :: Text+                                 -- ^ Text describing the check+                               , checkResultHostName :: Text+                                 -- ^ Name of the host which the check applies to+                               , checkResultStatus :: CheckStatus+                                 -- ^ Status result of the check+                               , checkResultTimestamp :: Maybe UTCTime+                                 -- ^ Time at which the check occurred (Nothing will wait until the+                                 -- check is sent to Datadog to compute the time)+                               , checkResultMessage :: Maybe Text+                                 -- ^ Information related to why this specific check run supplied+                                 -- the status it did+                               , checkResultTags :: [Tag]+                                 -- ^ Tags to associate with this check run+                               } deriving (Eq)++-- | A description of when downtime should occur.+data DowntimeSpec = DowntimeSpec { downtimeSpecStart :: Maybe UTCTime+                                   -- ^ When to start the downtime (or immediately)+                                 , downtimeSpecEnd :: Maybe UTCTime+                                   -- ^ When to stop the downtime (or indefinitely)+                                 , downtimeSpecMessage :: Maybe Text+                                   -- ^ A message to include with notifications for this downtime+                                 , downtimeSpecScope :: Tag+                                   -- ^ The scope to apply downtime to (if applying downtime to a+                                   -- host, use a tag of the form "host:hostname", NOT just+                                   -- "hostname")+                                 } deriving (Eq)+++-- | Datadog's internal reference to a specific donwtime instance.+type DowntimeId = Int+++-- | A scheduled donwtime stored in Datadog.+data Downtime = Downtime { downtimeId' :: DowntimeId+                           -- ^ Datadog's unique reference to the scheduled downtime+                         , downtimeSpec :: DowntimeSpec+                           -- ^ Context on the downtime schedule+                         } deriving (Eq)+++-- | A set of priorities used to denote the importance of an event.+data EventPriority = NormalPriority+                   | LowPriority+                   deriving (Eq)++instance Show EventPriority where+  show NormalPriority = "normal"+  show LowPriority = "low"++-- | The failure levels for an alert.+data AlertType = Error+               | Warning+               | Info+               | Success+               deriving (Eq)++instance Show AlertType where+  show Error = "error"+  show Warning = "warning"+  show Info = "info"+  show Success = "success"++-- | A source from which an event may originate, recognized by Datadog.+data SourceType = Nagios+                | Hudson+                | Jenkins+                | User+                | MyApps+                | Feed+                | Chef+                | Puppet+                | Git+                | BitBucket+                | Fabric+                | Capistrano+                deriving (Eq)++instance Show SourceType where+  show Nagios = "nagios"+  show Hudson = "hudson"+  show Jenkins = "jenkins"+  show User = "user"+  show MyApps = "my apps"+  show Feed = "feed"+  show Chef = "chef"+  show Puppet = "puppet"+  show Git = "git"+  show BitBucket = "bitbucket"+  show Fabric = "fabric"+  show Capistrano = "capistrano"++-- | Details that describe an event.+data EventSpec = EventSpec { eventSpecTitle :: Text+                           , eventSpecText :: Text+                             -- ^ The description/body of the event+                           , eventSpecDateHappened :: UTCTime+                             -- ^ The time at which the event occurred+                           , eventSpecPriority :: EventPriority+                           , eventSpecHost :: Maybe Text+                             -- ^ The hostname associated with the event+                           , eventSpecTags :: [Tag]+                           , eventSpecAlertType :: AlertType+                           , eventSpecSourceType :: Maybe SourceType+                             -- ^ The trigger of the event (if identifiable)+                           } deriving (Eq, Show)++-- | Datadog's internal reference to a specific event.+type EventId = Int++-- | An event stored within Datadog. An event represents some sort of+-- occurrence that was recorded in Datadog.+data Event = Event { eventId' :: EventId+                     -- ^ Datadog's unique reference to the event+                   , eventDetails :: EventSpec+                     -- ^ Context on what happened during this event+                   } deriving (Eq, Show)++data WrappedEvent = WrappedEvent { wrappedEvent :: Event }++data WrappedEvents = WrappedEvents { wrappedEvents :: [Event] }++newtype Series = Series { fromSeries :: DList Metric }+                 deriving (Monoid)++data MetricPoints = Gauge   [(POSIXTime, Float)]+                  | Counter [(POSIXTime, Int64)]++data Metric = Metric+  { metricName   :: Text+  , metricPoints :: MetricPoints+  , metricHost   :: Maybe Text+  , metricTags   :: [Text]+  }+ +-- | Each monitor is of a specific type, which determines what sort of check+-- the monitor performs.+data MonitorType = MetricAlert+                   -- ^ Watches a (combination of) metric(s), alerting when it+                   -- crosses some threshold.+                 | ServiceCheck+                   -- ^ Watches a service and alerts when the service enters a+                   -- failing state.+                 | EventAlert+                   -- ^ Checks the event stream for events meeting certain+                   -- criteria.+                 deriving (Eq)++instance Show MonitorType where+  show MetricAlert = "metric alert"+  show ServiceCheck = "service check"+  show EventAlert = "event alert"++-- | Advanced configuration parameters for a monitor.+data MonitorOptions = MonitorOptions { monitorOptionsSilenced :: HashMap T.Text (Maybe Integer)+                                     , monitorOptionsNotifyNoData :: Bool+                                     , monitorOptionsNoDataTimeframe :: Maybe Integer+                                     , monitorOptionsTimeoutH :: Maybe Integer+                                     , monitorOptionsRenotifyInterval :: Maybe Integer+                                     , monitorOptionsEscalationMessage :: T.Text+                                     , monitorOptionsNotifyAudit :: Bool+                                     } deriving (Eq)++-- | A representation of a monitor's configuration, from which a monitor could+-- be rebuilt.+data MonitorSpec = MonitorSpec { monitorSpecType' :: MonitorType+                               , monitorSpecQuery :: T.Text+                                 -- ^ The query string the monitor uses to+                                 -- determine its state.+                               , monitorSpecName :: Maybe T.Text+                                 -- ^ The human-readable name of the monitor.+                               , monitorSpecMessage :: Maybe T.Text+                                 -- ^ The message sent with the notification+                                 -- when the monitor is triggered.+                               , monitorSpecOptions :: MonitorOptions+                                 -- ^ Optional configuration parameters+                                 -- specifying advanced monitor beahviour.+                               } deriving (Eq)++-- | Datadog's internal reference to a specific monitor.+type MonitorId = Int++-- | A Datadog monitor. These monitors actively check multiple different types+-- of data within Datadog against user-provided conditions, triggering+-- notifications when condition(s) are met.+data Monitor = Monitor { monitorId' :: MonitorId+                         -- ^ Datadog's internal reference to this specific+                         -- monitor.+                       , monitorSpec :: MonitorSpec+                         -- ^ The specification from which this monitor can be+                         -- re-created.+                       } deriving (Eq)
+ src/Network/StatsD/Datadog.hs view
@@ -0,0 +1,400 @@+{-| 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 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,+  tag,+  ToMetricValue(..),+  value,+  Priority(..),+  AlertType(..),+  HasName(..),+  HasSampleRate(..),+  HasType'(..),+  HasTags(..),+  HasTitle(..),+  HasText(..),+  HasDateHappened(..),+  HasHostname(..),+  HasAggregationKey(..),+  HasPriority(..),+  HasSourceTypeName(..),+  HasAlertType(..),+  HasHost(..),+  HasPort(..),+  HasStatus(..),+  HasMessage(..),+  -- * Dummy client+  StatsClient(Dummy)+) where+import Control.Applicative ((<$>))+import Control.Exception (bracket)+import Control.Lens+import Control.Monad.Base+import Control.Monad.Trans.Control+import Control.Reaper+import Data.BufferBuilder.Utf8+import Data.List (intersperse)+import Data.Monoid+import Data.Maybe (isNothing)+import Data.Int+import Data.Word+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.Time.Format+import Data.Text.Encoding (encodeUtf8)+import Data.ByteString.Short hiding (empty)+import Network.Socket hiding (send, sendTo, recv, recvFrom)+import System.IO (hClose, hSetBuffering, BufferMode(LineBuffering), IOMode(WriteMode), Handle)++epochTime :: UTCTime -> Int+epochTime = round . utcTimeToPOSIXSeconds++newtype MetricName = MetricName { fromMetricName :: Text }++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 #-}++-- | 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 { fromTag :: Utf8Builder () }++-- | 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 k v = Tag (build k >> appendChar7 ':' >> build v)+  where+    build = appendText . 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 = appendDecimalSignedInt++instance ToMetricValue Double where+  encodeValue = appendDecimalDouble++-- | Smart 'Metric' constructor. Use the lens functions to set the optional fields.+metric :: (ToMetricValue a) => MetricName -> MetricType -> a -> Metric+metric n t v = Metric n 1 t (encodeValue v) []++-- | 'Metric'+--+-- The fields accessible through corresponding lenses are:+--+-- * 'name' @::@ 'MetricName'+--+-- * 'sampleRate' @::@ 'Double'+--+-- * 'type'' @::@ 'MetricType'+--+-- * 'value' @::@ 'ToMetricValue' @a => a@+--+-- * 'tags' @::@ @[@'Tag'@]@+data Metric = Metric+  { metricName       :: !MetricName+  , metricSampleRate :: {-# UNPACK #-} !Double+  , metricType'      :: !MetricType+  , mValue           :: !(Utf8Builder ())+  , 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 = sets $ \f m -> m { mValue = encodeValue $ f $ mValue m }+{-# INLINE value #-}++renderMetric :: Metric -> Utf8Builder ()+renderMetric (Metric n sr t v ts) = do+  appendText $ cleanMetricText $ fromMetricName n+  appendChar7 ':'+  v+  appendChar7 '|'+  unit+  formatRate+  formatTags+  where+    unit = case t of+      Gauge     -> appendChar7 'g'+      Counter   -> appendChar7 'c'+      Timer     -> appendBS7 "ms"+      Histogram -> appendChar7 'h'+      Set       -> appendChar7 's'+    formatTags = case ts of+      [] -> return ()+      xs -> appendBS7 "|#" >> F.sequence_ (intersperse (appendChar7 ',') $ map fromTag xs)+    formatRate = if sr == 1 then return () else appendBS7 "|@" >> appendDecimalDouble 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 t d = Event t d Nothing Nothing Nothing Nothing Nothing 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+  { eventTitle          :: {-# UNPACK #-} !Text+  , eventText           :: {-# UNPACK #-} !Text+  , eventDateHappened   :: !(Maybe UTCTime)+  , eventHostname       :: !(Maybe Text)+  , eventAggregationKey :: !(Maybe Text)+  , eventPriority       :: !(Maybe Priority)+  , eventSourceTypeName :: !(Maybe Text)+  , eventAlertType      :: !(Maybe AlertType)+  , eventTags           :: ![Tag]+  }++makeFields ''Event++renderEvent :: 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 = encodeUtf8 $ escapeEventContents $ eventTitle e+    escapedText = encodeUtf8 $ escapeEventContents $ eventText e+    makeField c v = F.forM_ v $ \jv ->+      appendChar7 '|' >> appendChar7 c >> appendChar7 ':' >> jv+    cleanTextValue f = (appendText . cleanMetricText) <$> f e+    -- TODO figure out the actual format that dateHappened values are supposed to have.+    happened = F.forM_ (eventDateHappened e) $ \h -> do+      appendBS7 "|d:"+      appendDecimalSignedInt $ epochTime h+    formatHostname = makeField 'h' $ cleanTextValue eventHostname+    aggregation = makeField 'k' $ cleanTextValue eventAggregationKey+    formatPriority = F.forM_ (eventPriority e) $ \p -> do+      appendBS7 "|p:"+      appendBS7 $ case p of+        Low    -> "low"+        Normal -> "normal"+    sourceType = makeField 's' $ cleanTextValue eventSourceTypeName+    alert = F.forM_ (eventAlertType e) $ \a -> do+              appendBS7 "|t:"+              appendBS7 $ case a of+                Error   -> "error"+                Warning -> "warning"+                Info    -> "info"+                Success -> "success"+    formatTags = case eventTags e of+      [] -> return ()+      ts -> do+        appendBS7 "|#"+        sequence_ $ intersperse (appendChar7 ',') $ map fromTag ts++data ServiceCheckStatus = ServiceOk | ServiceWarning | ServiceCritical | ServiceUnknown+  deriving (Read, Show, Eq, Ord, 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+  { serviceCheckName         :: {-# UNPACK #-} !Text+  , serviceCheckStatus       :: !ServiceCheckStatus+  , serviceCheckMessage      :: !(Maybe Text)+  , serviceCheckDateHappened :: !(Maybe UTCTime)+  , serviceCheckHostname     :: !(Maybe Text)+  , serviceCheckTags         :: ![Tag]+  }++makeFields ''ServiceCheck++serviceCheck :: Text -- ^ name+             -> ServiceCheckStatus+             -> ServiceCheck+serviceCheck n s = 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 Metric where+  toStatsD = renderMetric++instance ToStatsD Event where+  toStatsD = renderEvent++instance ToStatsD ServiceCheck where+  toStatsD check = do+    appendBS7 "_sc|"+    appendText $ cleanMetricText $ check ^. name+    appendChar7 '|'+    appendDecimalSignedInt $ fromEnum $ check ^. status+    F.forM_ (check ^. message) $ \msg ->+      appendBS7 "|m:" >> appendText (cleanMetricText msg)+    F.forM_ (check ^. dateHappened) $ \ts -> do+      appendBS7 "|d:"+      appendDecimalSignedInt $ epochTime ts+    F.forM_ (check ^. hostname) $ \hn ->+      appendBS7 "|h:" >> appendText (cleanMetricText hn)+    case check ^. tags of+      [] -> return ()+      ts -> do+        appendBS7 "|#"+        sequence_ $ intersperse (appendChar7 ',') $ map fromTag ts++data DogStatsSettings = DogStatsSettings+  { dogStatsSettingsHost     :: HostName -- ^ The hostname or IP of the DogStatsD server (default: 127.0.0.1)+  , dogStatsSettingsPort     :: Int      -- ^ The port that the DogStatsD server is listening on (default: 8125)+  }++makeFields ''DogStatsSettings++defaultSettings :: DogStatsSettings+defaultSettings = DogStatsSettings "127.0.0.1" 8125++mkStatsClient :: MonadBase IO m => DogStatsSettings -> m StatsClient+mkStatsClient s = liftBase $ do+  addrInfos <- getAddrInfo+               (Just $ defaultHints { addrFlags = [AI_PASSIVE] })+               (Just $ s ^. host)+               (Just $ show $ s ^. 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 $ StatsClient h r++withDogStatsD :: MonadBaseControl IO m => DogStatsSettings -> (StatsClient -> m a) -> m a+withDogStatsD s f = liftBaseOp+  (bracket (mkStatsClient s) (\c -> finalizeStatsClient c >> hClose (statsClientHandle c))) f++-- | Note that Dummy is not the only constructor, just the only publicly available one.+data StatsClient = StatsClient+                   { statsClientHandle :: !Handle+                   , statsClientReaper :: Reaper (Maybe (Utf8Builder ())) (Utf8Builder ())+                   }+                 | 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 :: (MonadBase IO m, ToStatsD v) => StatsClient -> v -> m ()+send (StatsClient _ r) v = liftBase $ reaperAdd r (toStatsD v >> appendChar7 '\n')+send Dummy _ = return ()+{-# INLINEABLE send #-}++finalizeStatsClient :: StatsClient -> IO ()+finalizeStatsClient (StatsClient h r) = reaperStop r >>= F.mapM_ (B.hPut h . runUtf8Builder)+finalizeStatsClient Dummy = return ()
+ test/Spec.hs view
@@ -0,0 +1,6 @@+import Test.Hspec (hspec)++import Test.Network.Datadog (spec)++main :: IO ()+main = hspec spec
+ test/Test/Network/Datadog.hs view
@@ -0,0 +1,19 @@+module Test.Network.Datadog (spec) where++import Test.Hspec (Spec, describe)++import qualified Test.Network.Datadog.Check as Check (spec)+import qualified Test.Network.Datadog.Downtime as Downtime (spec)+import qualified Test.Network.Datadog.Event as Event (spec)+import qualified Test.Network.Datadog.Host as Host (spec)+import qualified Test.Network.Datadog.Monitor as Monitor (spec)+import qualified Test.Network.Datadog.StatsD as StatsD (spec)++spec :: Spec+spec = describe "Datadog spec" $ do+  StatsD.spec+  Check.spec+  Downtime.spec+  Event.spec+  Host.spec+  Monitor.spec
+ test/Test/Network/Datadog/Check.hs view
@@ -0,0 +1,32 @@+module Test.Network.Datadog.Check (spec) where++import Test.Hspec (Spec, describe, it)++import Network.Datadog (Environment, createEnvironment, loadKeysFromEnv)+import Network.Datadog.Check+  ( CheckResult (CheckResult)+  , CheckStatus (CheckOk)+  , checkResultCheck+  , checkResultHostName+  , checkResultMessage+  , checkResultStatus+  , checkResultTags+  , checkResultTimestamp+  , recordCheck+  )++spec :: Spec+spec = describe "Check spec" $ do+  it "Records a status check" $ do+    let environment :: IO Environment+        environment = createEnvironment =<< loadKeysFromEnv+        check = CheckResult+          { checkResultCheck = "Datadog Test Check"+          , checkResultHostName = "development"+          , checkResultStatus = CheckOk+          , checkResultTimestamp = Nothing+          , checkResultMessage = Nothing+          , checkResultTags = []+          }+    env <- environment+    recordCheck env check
+ test/Test/Network/Datadog/Downtime.hs view
@@ -0,0 +1,42 @@+module Test.Network.Datadog.Downtime (spec) where++import Control.Concurrent (threadDelay)+import Control.Lens ((&), (?~), (^.))+import Control.Monad (when)+import Data.Time.Clock (addUTCTime, getCurrentTime)+import Test.Hspec (Spec, describe, expectationFailure, it)++import Network.Datadog (Environment, createEnvironment, loadKeysFromEnv)+import Network.Datadog.Downtime+  ( cancelDowntime+  , end+  , id'+  , loadDowntime+  , loadDowntimes+  , minimalDowntimeSpec+  , scheduleDowntime+  , updateDowntime+  )++spec :: Spec+spec = describe "Downtime spec" $ do+  it "Does downtime CRUD operations" $ do+    let environment :: IO Environment+        environment = createEnvironment =<< loadKeysFromEnv+        downtimeDetails = minimalDowntimeSpec $ read "haskell-datadog-test-scope"+    env <- environment+    time <- getCurrentTime+    let downtimeUpdatedDetails = downtimeDetails & end ?~ addUTCTime 300 time+    downtime1 <- scheduleDowntime env downtimeDetails+    threadDelay 500000+    downtime2 <- updateDowntime env (downtime1 ^. id') downtimeUpdatedDetails+    threadDelay 500000+    downtime3 <- loadDowntime env (downtime1 ^. id')+    threadDelay 500000+    downtimes <- loadDowntimes env False+    threadDelay 500000+    cancelDowntime env (downtime1 ^. id')+    when (downtime2 /= downtime3) $+      expectationFailure "Updated and fetched downtimes are not identical"+    when (downtime2 `notElem` downtimes) $+      expectationFailure "Created downtime not updated (in group load)"
+ test/Test/Network/Datadog/Event.hs view
@@ -0,0 +1,34 @@+module Test.Network.Datadog.Event (spec) where++import Control.Concurrent (threadDelay)+import Control.Lens ((^.))+import Control.Monad (when)+import Data.Time.Clock (addUTCTime, getCurrentTime)+import Test.Hspec (Spec, describe, expectationFailure, it)++import Network.Datadog (Environment, createEnvironment, loadKeysFromEnv)+import Network.Datadog.Event+  (EventPriority (NormalPriority), createEvent, id', loadEvent, loadEvents, minimalEventSpec)++spec :: Spec+spec = describe "Event spec" $ do+  it "Does event creation and loading methods" $ do+    let environment :: IO Environment+        environment = createEnvironment =<< loadKeysFromEnv+    env <- environment+    time <- getCurrentTime+    let testDetails = minimalEventSpec+          "Datadog Test Event"+          "This is a test for the Haskell Datadog API."+          time+          NormalPriority+    threadDelay 500000+    event1 <- createEvent env testDetails+    threadDelay 20000000+    event2 <- loadEvent env (event1 ^. id')+    threadDelay 500000+    events <- loadEvents env (addUTCTime (-60) time, addUTCTime 60 time) Nothing []+    when (event1 /= event2) $+      expectationFailure "Created and fetched events are not identical"+    when (event1 `notElem` events) $+      expectationFailure "Created event not fetched from group load"
+ test/Test/Network/Datadog/Host.hs view
@@ -0,0 +1,38 @@+module Test.Network.Datadog.Host (spec) where++import Control.Concurrent (threadDelay)+import Data.Semigroup ((<>))+import Data.Text (Text, pack)+import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime)+import System.Random (randomIO)+import Test.Hspec (Spec, describe, it)++import Network.Datadog (Environment, createEnvironment, loadKeysFromEnv)+import Network.Datadog.Host (muteHost, unmuteHost)++performMute :: Environment -> Text -> Maybe UTCTime -> Bool -> IO ()+performMute env host time override = do+  threadDelay 1000000+  muteHost env host time override++performUnmute :: Environment -> Text -> IO ()+performUnmute env host = do+  threadDelay 1000000+  unmuteHost env host++spec :: Spec+spec = describe "Host spec" $ do+  it "Mutes and unmutes hosts" $ do+    let environment :: IO Environment+        environment = createEnvironment =<< loadKeysFromEnv+    env <- environment+    time <- getCurrentTime+    host <- ("haskell-datadog-test-host-" <>) . pack . show <$> (randomIO :: IO Word)+    -- Ensure overriding works+    performMute env host Nothing True+    performMute env host (Just (addUTCTime 30 time)) True+    -- Unmute the host before we test no override option+    performUnmute env host+    performMute env host Nothing False+    -- Unmute for "cleanup"+    performUnmute env host
+ test/Test/Network/Datadog/Monitor.hs view
@@ -0,0 +1,44 @@+module Test.Network.Datadog.Monitor (spec) where++import Control.Concurrent (threadDelay)+import Control.Lens ((^.))+import Control.Monad (when)+import Test.Hspec (Spec, describe, expectationFailure, it)++import Network.Datadog (Environment, createEnvironment, loadKeysFromEnv)+import Network.Datadog.Monitor+  ( MonitorType (MetricAlert)+  , createMonitor+  , deleteMonitor+  , id'+  , loadMonitor+  , loadMonitors+  , minimalMonitorSpec+  , monitorSpecName+  , updateMonitor+  )++spec :: Spec+spec = describe "Monitor spec" $ do+  it "Does monitor CRUD operations" $ do+    let environment :: IO Environment+        environment = createEnvironment =<< loadKeysFromEnv+        monitorDetails = minimalMonitorSpec+          MetricAlert+          "avg(last_5m):sum:system.net.bytes_rcvd{host:host0} > 100"+        monitorUpdatedDetails = monitorDetails { monitorSpecName = Just "Haskell Datadog test monitor" }+    env <- environment+    threadDelay 500000+    monitor1 <- createMonitor env monitorDetails+    threadDelay 500000+    monitor2 <- updateMonitor env (monitor1 ^. id') monitorUpdatedDetails+    threadDelay 500000+    monitor3 <- loadMonitor env (monitor1 ^. id')+    threadDelay 500000+    monitors <- loadMonitors env []+    threadDelay 500000+    deleteMonitor env (monitor1 ^. id')+    when (monitor2 /= monitor3) $+      expectationFailure "Updated and fetched monitors are not identical"+    when (monitor2 `notElem` monitors) $+      expectationFailure "Created monitor not updated (in group load)"
+ test/Test/Network/Datadog/StatsD.hs view
@@ -0,0 +1,39 @@+module Test.Network.Datadog.StatsD (spec) where++import Control.Monad.Catch (bracket)+import Network.Socket+  ( AddrInfoFlag (AI_PASSIVE)+  , Socket+  , SocketType (Datagram)+  , addrAddress+  , addrFamily+  , addrFlags+  , bind+  , close+  , defaultHints+  , defaultProtocol+  , getAddrInfo+  , recvFrom+  , socket+  )+import System.Timeout (timeout)+import Test.Hspec (Spec, describe, expectationFailure, it)++import Network.StatsD.Datadog (defaultSettings, event, send, withDogStatsD)++spec :: Spec+spec = describe "StatsD spec" $ do+  it "Sends DogStatsD data to a local server" $ do+    let makeServer :: IO Socket+        makeServer = do+          (serverAddr:_) <- getAddrInfo (Just defaultHints { addrFlags = [AI_PASSIVE] }) Nothing (Just "8125")+          sock <- socket (addrFamily serverAddr) Datagram defaultProtocol+          bind sock (addrAddress serverAddr)+          return sock+    bracket makeServer close $ \conn -> do+      withDogStatsD defaultSettings $ \stats -> do+        send stats $ event "foo" "bar"+      val <- timeout 10000000 $ recvFrom conn 2048+      case val of+        Just _  -> pure ()+        Nothing -> expectationFailure "Did not receive DogStatsD event"