{-# 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 :: MonitorOptions -> [(Text, Maybe UTCTime)]
getSilencedMonitorScopes MonitorOptions
opts = ((Text, Maybe Integer) -> (Text, Maybe UTCTime))
-> [(Text, Maybe Integer)] -> [(Text, Maybe UTCTime)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Integer -> Maybe UTCTime)
-> (Text, Maybe Integer) -> (Text, Maybe UTCTime)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Integer -> UTCTime) -> Maybe Integer -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Integer -> POSIXTime) -> Integer -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral))) ([(Text, Maybe Integer)] -> [(Text, Maybe UTCTime)])
-> [(Text, Maybe Integer)] -> [(Text, Maybe UTCTime)]
forall a b. (a -> b) -> a -> b
$ HashMap Text (Maybe Integer) -> [(Text, Maybe Integer)]
forall k v. HashMap k v -> [(k, v)]
Data.HashMap.toList (HashMap Text (Maybe Integer) -> [(Text, Maybe Integer)])
-> HashMap Text (Maybe Integer) -> [(Text, Maybe Integer)]
forall a b. (a -> b) -> a -> b
$ MonitorOptions
opts MonitorOptions
-> Getting
     (HashMap Text (Maybe Integer))
     MonitorOptions
     (HashMap Text (Maybe Integer))
-> HashMap Text (Maybe Integer)
forall s a. s -> Getting a s a -> a
^. Getting
  (HashMap Text (Maybe Integer))
  MonitorOptions
  (HashMap Text (Maybe Integer))
forall s a. HasSilenced s a => Lens' s a
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 :: Text -> Maybe UTCTime -> MonitorOptions -> MonitorOptions
silenceMonitorScope Text
scopeName Maybe UTCTime
mtime MonitorOptions
old = MonitorOptions
old MonitorOptions
-> (MonitorOptions -> MonitorOptions) -> MonitorOptions
forall a b. a -> (a -> b) -> b
& (HashMap Text (Maybe Integer)
 -> Identity (HashMap Text (Maybe Integer)))
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasSilenced s a => Lens' s a
silenced ((HashMap Text (Maybe Integer)
  -> Identity (HashMap Text (Maybe Integer)))
 -> MonitorOptions -> Identity MonitorOptions)
-> (HashMap Text (Maybe Integer) -> HashMap Text (Maybe Integer))
-> MonitorOptions
-> MonitorOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ HashMap Text (Maybe Integer) -> HashMap Text (Maybe Integer)
silenceF
  where silenceF :: HashMap Text (Maybe Integer) -> HashMap Text (Maybe Integer)
silenceF = Text
-> Maybe Integer
-> HashMap Text (Maybe Integer)
-> HashMap Text (Maybe Integer)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Data.HashMap.insert Text
scopeName ((UTCTime -> Integer) -> Maybe UTCTime -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer)
-> (UTCTime -> POSIXTime) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds) Maybe UTCTime
mtime)

-- | Remove the silencer from a given scope, if the scope is currently
-- silenced.
unsilenceMonitorScope :: T.Text -> MonitorOptions -> MonitorOptions
unsilenceMonitorScope :: Text -> MonitorOptions -> MonitorOptions
unsilenceMonitorScope Text
scopeName MonitorOptions
old = MonitorOptions
old MonitorOptions
-> (MonitorOptions -> MonitorOptions) -> MonitorOptions
forall a b. a -> (a -> b) -> b
& (HashMap Text (Maybe Integer)
 -> Identity (HashMap Text (Maybe Integer)))
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasSilenced s a => Lens' s a
silenced ((HashMap Text (Maybe Integer)
  -> Identity (HashMap Text (Maybe Integer)))
 -> MonitorOptions -> Identity MonitorOptions)
-> (HashMap Text (Maybe Integer) -> HashMap Text (Maybe Integer))
-> MonitorOptions
-> MonitorOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
-> HashMap Text (Maybe Integer) -> HashMap Text (Maybe Integer)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
Data.HashMap.delete Text
scopeName)

-- | Unsilence every scope in the monitor, including the global scope.
unsilenceAllMonitorScope :: MonitorOptions -> MonitorOptions
unsilenceAllMonitorScope :: MonitorOptions -> MonitorOptions
unsilenceAllMonitorScope = ((HashMap Text (Maybe Integer)
  -> Identity (HashMap Text (Maybe Integer)))
 -> MonitorOptions -> Identity MonitorOptions)
-> HashMap Text (Maybe Integer) -> MonitorOptions -> MonitorOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set (HashMap Text (Maybe Integer)
 -> Identity (HashMap Text (Maybe Integer)))
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasSilenced s a => Lens' s a
silenced HashMap Text (Maybe Integer)
forall k v. HashMap k v
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 :: MonitorOptions -> Maybe POSIXTime
doesNotifyOnNoMonitorData MonitorOptions
opts = if MonitorOptions
opts MonitorOptions -> Getting Bool MonitorOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool MonitorOptions Bool
forall s a. HasNotifyNoData s a => Lens' s a
notifyNoData
                                   then POSIXTime -> Maybe POSIXTime
forall a. a -> Maybe a
Just (POSIXTime -> Maybe POSIXTime) -> POSIXTime -> Maybe POSIXTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> (Integer -> POSIXTime) -> Maybe Integer -> POSIXTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AssertionFailed -> POSIXTime
forall a e. Exception e => e -> a
throw (String -> AssertionFailed
AssertionFailed String
"Datadog Library internal error")) (Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> POSIXTime)
-> (Integer -> Integer) -> Integer -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
60)) (Maybe Integer -> POSIXTime) -> Maybe Integer -> POSIXTime
forall a b. (a -> b) -> a -> b
$ MonitorOptions
opts MonitorOptions
-> Getting (Maybe Integer) MonitorOptions (Maybe Integer)
-> Maybe Integer
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Integer) MonitorOptions (Maybe Integer)
forall s a. HasNoDataTimeframe s a => Lens' s a
noDataTimeframe
                                   else Maybe POSIXTime
forall a. Maybe a
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 :: POSIXTime -> MonitorOptions -> MonitorOptions
notifyOnNoMonitorData POSIXTime
difftime MonitorOptions
old = MonitorOptions
old MonitorOptions
-> (MonitorOptions -> MonitorOptions) -> MonitorOptions
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool)
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasNotifyNoData s a => Lens' s a
notifyNoData ((Bool -> Identity Bool)
 -> MonitorOptions -> Identity MonitorOptions)
-> Bool -> MonitorOptions -> MonitorOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True MonitorOptions
-> (MonitorOptions -> MonitorOptions) -> MonitorOptions
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasNoDataTimeframe s a => Lens' s a
noDataTimeframe ((Maybe Integer -> Identity (Maybe Integer))
 -> MonitorOptions -> Identity MonitorOptions)
-> Integer -> MonitorOptions -> MonitorOptions
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Integer
stamp
  where stamp :: Integer
stamp = POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime
difftime POSIXTime -> POSIXTime -> POSIXTime
forall a. Fractional a => a -> a -> a
/ POSIXTime
60)

-- | Prevent the monitor from notifying when it is missing data.
noNotifyOnNoMonitorData :: MonitorOptions -> MonitorOptions
noNotifyOnNoMonitorData :: MonitorOptions -> MonitorOptions
noNotifyOnNoMonitorData MonitorOptions
old = MonitorOptions
old MonitorOptions
-> (MonitorOptions -> MonitorOptions) -> MonitorOptions
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool)
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasNotifyNoData s a => Lens' s a
notifyNoData ((Bool -> Identity Bool)
 -> MonitorOptions -> Identity MonitorOptions)
-> Bool -> MonitorOptions -> MonitorOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False MonitorOptions
-> (MonitorOptions -> MonitorOptions) -> MonitorOptions
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasNoDataTimeframe s a => Lens' s a
noDataTimeframe ((Maybe Integer -> Identity (Maybe Integer))
 -> MonitorOptions -> Identity MonitorOptions)
-> Maybe Integer -> MonitorOptions -> MonitorOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Integer
forall a. Maybe a
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 :: MonitorOptions -> Maybe POSIXTime
getMonitorTimeout MonitorOptions
opts = (Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> POSIXTime)
-> (Integer -> Integer) -> Integer -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
3600)) (Integer -> POSIXTime) -> Maybe Integer -> Maybe POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonitorOptions
opts MonitorOptions
-> Getting (Maybe Integer) MonitorOptions (Maybe Integer)
-> Maybe Integer
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Integer) MonitorOptions (Maybe Integer)
forall s a. HasTimeoutH s a => Lens' s a
timeoutH)

-- | Have the monitor stop alerting some time after it is triggered (rounded up
-- to the nearest hour).
setMonitorTimeout :: NominalDiffTime -> MonitorOptions -> MonitorOptions
setMonitorTimeout :: POSIXTime -> MonitorOptions -> MonitorOptions
setMonitorTimeout POSIXTime
difftime MonitorOptions
old = MonitorOptions
old MonitorOptions
-> (MonitorOptions -> MonitorOptions) -> MonitorOptions
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasTimeoutH s a => Lens' s a
timeoutH ((Maybe Integer -> Identity (Maybe Integer))
 -> MonitorOptions -> Identity MonitorOptions)
-> Integer -> MonitorOptions -> MonitorOptions
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Integer
stamp
  where stamp :: Integer
stamp = POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (POSIXTime
difftime POSIXTime -> POSIXTime -> POSIXTime
forall a. Fractional a => a -> a -> a
/ POSIXTime
3600)

-- | Prevent the monitor from timing out after it is triggered.
clearMonitorTimeout :: MonitorOptions -> MonitorOptions
clearMonitorTimeout :: MonitorOptions -> MonitorOptions
clearMonitorTimeout = ((Maybe Integer -> Identity (Maybe Integer))
 -> MonitorOptions -> Identity MonitorOptions)
-> Maybe Integer -> MonitorOptions -> MonitorOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set (Maybe Integer -> Identity (Maybe Integer))
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasTimeoutH s a => Lens' s a
timeoutH Maybe Integer
forall a. Maybe a
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 :: MonitorOptions -> Maybe (POSIXTime, Maybe Text)
doesRenotifyMonitor MonitorOptions
opts = (\Integer
i -> (Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60), Maybe Text
result)) (Integer -> (POSIXTime, Maybe Text))
-> Maybe Integer -> Maybe (POSIXTime, Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MonitorOptions
opts MonitorOptions
-> Getting (Maybe Integer) MonitorOptions (Maybe Integer)
-> Maybe Integer
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Integer) MonitorOptions (Maybe Integer)
forall s a. HasRenotifyInterval s a => Lens' s a
renotifyInterval)
  where msg :: Text
msg = MonitorOptions
opts MonitorOptions -> Getting Text MonitorOptions Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text MonitorOptions Text
forall s a. HasEscalationMessage s a => Lens' s a
escalationMessage
        result :: Maybe Text
result = if Text -> Bool
T.null Text
msg then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
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 :: POSIXTime -> Maybe Text -> MonitorOptions -> MonitorOptions
renotifyMonitor POSIXTime
difftime Maybe Text
mMessage MonitorOptions
old = MonitorOptions
old MonitorOptions
-> (MonitorOptions -> MonitorOptions) -> MonitorOptions
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasRenotifyInterval s a => Lens' s a
renotifyInterval ((Maybe Integer -> Identity (Maybe Integer))
 -> MonitorOptions -> Identity MonitorOptions)
-> Integer -> MonitorOptions -> MonitorOptions
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Integer
stamp MonitorOptions
-> (MonitorOptions -> MonitorOptions) -> MonitorOptions
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasEscalationMessage s a => Lens' s a
escalationMessage ((Text -> Identity Text)
 -> MonitorOptions -> Identity MonitorOptions)
-> Text -> MonitorOptions -> MonitorOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
msg
  where stamp :: Integer
stamp = POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime
difftime POSIXTime -> POSIXTime -> POSIXTime
forall a. Fractional a => a -> a -> a
/ POSIXTime
60)
        msg :: Text
msg = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mMessage

-- | Prevent the monitor from re-notifying after it triggers an un-resolved
-- notification.
noRenotifyMonitor :: MonitorOptions -> MonitorOptions
noRenotifyMonitor :: MonitorOptions -> MonitorOptions
noRenotifyMonitor MonitorOptions
old = MonitorOptions
old MonitorOptions
-> (MonitorOptions -> MonitorOptions) -> MonitorOptions
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasRenotifyInterval s a => Lens' s a
renotifyInterval ((Maybe Integer -> Identity (Maybe Integer))
 -> MonitorOptions -> Identity MonitorOptions)
-> Maybe Integer -> MonitorOptions -> MonitorOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Integer
forall a. Maybe a
Nothing MonitorOptions
-> (MonitorOptions -> MonitorOptions) -> MonitorOptions
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasEscalationMessage s a => Lens' s a
escalationMessage ((Text -> Identity Text)
 -> MonitorOptions -> Identity MonitorOptions)
-> Text -> MonitorOptions -> MonitorOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
""

-- | Determine if the monitor triggers a notification when it is modified.
doesNotifyOnAudit :: MonitorOptions -> Bool
doesNotifyOnAudit :: MonitorOptions -> Bool
doesNotifyOnAudit = Getting Bool MonitorOptions Bool -> MonitorOptions -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool MonitorOptions Bool
forall s a. HasNotifyAudit s a => Lens' s a
notifyAudit

-- | Have the monitor trigger a notification when it is modified.
notifyOnAudit :: MonitorOptions -> MonitorOptions
notifyOnAudit :: MonitorOptions -> MonitorOptions
notifyOnAudit = ((Bool -> Identity Bool)
 -> MonitorOptions -> Identity MonitorOptions)
-> Bool -> MonitorOptions -> MonitorOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set (Bool -> Identity Bool)
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasNotifyAudit s a => Lens' s a
notifyAudit Bool
True

-- | Prevent the monitor from triggering a notification when it is modified.
noNotifyOnAudit :: MonitorOptions -> MonitorOptions
noNotifyOnAudit :: MonitorOptions -> MonitorOptions
noNotifyOnAudit = ((Bool -> Identity Bool)
 -> MonitorOptions -> Identity MonitorOptions)
-> Bool -> MonitorOptions -> MonitorOptions
forall s t a b. ASetter s t a b -> b -> s -> t
set (Bool -> Identity Bool)
-> MonitorOptions -> Identity MonitorOptions
forall s a. HasNotifyAudit s a => Lens' s a
notifyAudit Bool
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 :: MonitorType -> Text -> MonitorSpec
minimalMonitorSpec MonitorType
cmtype Text
cmquery = MonitorSpec :: MonitorType
-> Text
-> Maybe Text
-> Maybe Text
-> MonitorOptions
-> MonitorSpec
MonitorSpec { monitorSpecType' :: MonitorType
monitorSpecType' = MonitorType
cmtype
                                                , monitorSpecQuery :: Text
monitorSpecQuery = Text
cmquery
                                                , monitorSpecName :: Maybe Text
monitorSpecName = Maybe Text
forall a. Maybe a
Nothing
                                                , monitorSpecMessage :: Maybe Text
monitorSpecMessage = Maybe Text
forall a. Maybe a
Nothing
                                                , monitorSpecOptions :: MonitorOptions
monitorSpecOptions = MonitorOptions
defaultMonitorOptions
                                                }

-- | Create a new monitor in Datadog matching a specification.
createMonitor :: Environment -> MonitorSpec -> IO Monitor
createMonitor :: Environment -> MonitorSpec -> IO Monitor
createMonitor Environment
env MonitorSpec
monitorspec =
  let path :: p
path = p
"monitor"
  in Environment
-> String
-> [(String, String)]
-> StdMethod
-> Maybe ByteString
-> IO ByteString
datadogHttp Environment
env String
forall p. IsString p => p
path [] StdMethod
POST (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ MonitorSpec -> ByteString
forall a. ToJSON a => a -> ByteString
encode MonitorSpec
monitorspec) IO ByteString -> (ByteString -> IO Monitor) -> IO Monitor
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
     String -> ByteString -> IO Monitor
forall a. FromJSON a => String -> ByteString -> IO a
decodeDatadog String
"createMonitor"


-- | Load a monitor from Datadog by its ID.
loadMonitor :: Environment -> MonitorId -> IO Monitor
loadMonitor :: Environment -> MonitorId -> IO Monitor
loadMonitor Environment
env MonitorId
monitorId =
  let path :: String
path = String
"monitor/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ MonitorId -> String
forall a. Show a => a -> String
show MonitorId
monitorId
  in Environment
-> String
-> [(String, String)]
-> StdMethod
-> Maybe ByteString
-> IO ByteString
datadogHttp Environment
env String
path [] StdMethod
GET Maybe ByteString
forall a. Maybe a
Nothing IO ByteString -> (ByteString -> IO Monitor) -> IO Monitor
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
     String -> ByteString -> IO Monitor
forall a. FromJSON a => String -> ByteString -> IO a
decodeDatadog String
"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 :: Environment -> MonitorId -> MonitorSpec -> IO Monitor
updateMonitor Environment
env MonitorId
monitorId MonitorSpec
mspec =
  let path :: String
path = String
"monitor/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ MonitorId -> String
forall a. Show a => a -> String
show MonitorId
monitorId
  in Environment
-> String
-> [(String, String)]
-> StdMethod
-> Maybe ByteString
-> IO ByteString
datadogHttp Environment
env String
path [] StdMethod
PUT (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ MonitorSpec -> ByteString
forall a. ToJSON a => a -> ByteString
encode MonitorSpec
mspec) IO ByteString -> (ByteString -> IO Monitor) -> IO Monitor
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
     String -> ByteString -> IO Monitor
forall a. FromJSON a => String -> ByteString -> IO a
decodeDatadog String
"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 :: Environment -> MonitorId -> IO ()
deleteMonitor Environment
env MonitorId
monitorId =
  let path :: String
path = String
"monitor/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ MonitorId -> String
forall a. Show a => a -> String
show MonitorId
monitorId
  in IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ByteString -> IO ()) -> IO ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Environment
-> String
-> [(String, String)]
-> StdMethod
-> Maybe ByteString
-> IO ByteString
datadogHttp Environment
env String
path [] StdMethod
DELETE Maybe ByteString
forall a. Maybe a
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 :: Environment -> [Tag] -> IO [Monitor]
loadMonitors Environment
env [Tag]
filterTags =
  let path :: p
path = p
"monitor"
      q :: [(String, String)]
q = [(String
"tags", String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((Tag -> String) -> [Tag] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Tag -> String
forall a. Show a => a -> String
show [Tag]
filterTags)) | Bool -> Bool
not ([Tag] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tag]
filterTags)]
  in Environment
-> String
-> [(String, String)]
-> StdMethod
-> Maybe ByteString
-> IO ByteString
datadogHttp Environment
env String
forall p. IsString p => p
path [(String, String)]
q StdMethod
GET Maybe ByteString
forall a. Maybe a
Nothing IO ByteString -> (ByteString -> IO [Monitor]) -> IO [Monitor]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
     String -> ByteString -> IO [Monitor]
forall a. FromJSON a => String -> ByteString -> IO a
decodeDatadog String
"loadMonitors"


-- | Prevent all monitors from notifying indefinitely.
muteAllMonitors :: Environment -> IO ()
muteAllMonitors :: Environment -> IO ()
muteAllMonitors Environment
env =
  let path :: p
path = p
"monitor/mute_all"
  in IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ByteString -> IO ()) -> IO ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Environment
-> String
-> [(String, String)]
-> StdMethod
-> Maybe ByteString
-> IO ByteString
datadogHttp Environment
env String
forall p. IsString p => p
path [] StdMethod
POST Maybe ByteString
forall a. Maybe a
Nothing


-- | Allow all monitors to notify.
unmuteAllMonitors :: Environment -> IO ()
unmuteAllMonitors :: Environment -> IO ()
unmuteAllMonitors Environment
env =
  let path :: p
path = p
"monitor/unmute_all"
  in IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ByteString -> IO ()) -> IO ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Environment
-> String
-> [(String, String)]
-> StdMethod
-> Maybe ByteString
-> IO ByteString
datadogHttp Environment
env String
forall p. IsString p => p
path [] StdMethod
POST Maybe ByteString
forall a. Maybe a
Nothing