{-# LANGUAGE OverloadedStrings #-}
{-# 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 <- parseUrlThrow $ 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 $ parseUrlThrow "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
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)
]
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