{-# 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.Semigroup
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 { Timestamp -> NominalDiffTime
fromTimestamp :: NominalDiffTime }

newtype Write = Write { Write -> ByteString
writeApiKey :: ByteString }

data ReadWrite = ReadWrite { ReadWrite -> ByteString
readWriteApiKey :: ByteString
                           , ReadWrite -> ByteString
readWriteApplicationKey :: ByteString
                           }

data DatadogClient a = DatadogClient
  { DatadogClient a -> Manager
datadogClientManager        :: Manager
  , DatadogClient a -> a
datadogClientKeys           :: a
  }


-- | Wraps the keys needed by Datadog to fully access the API.
data Keys = Keys { Keys -> String
apiKey :: String
                   -- A write-key associated with a user
                 , Keys -> String
appKey :: String
                   -- A read-key associated with an application
                 } deriving (Keys -> Keys -> Bool
(Keys -> Keys -> Bool) -> (Keys -> Keys -> Bool) -> Eq Keys
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Keys -> Keys -> Bool
$c/= :: Keys -> Keys -> Bool
== :: Keys -> Keys -> Bool
$c== :: Keys -> Keys -> Bool
Eq)


-- | An Environment contains everything needed to interact with Datadog.
data Environment = Environment { Environment -> Keys
environmentKeys :: Keys
                                 -- ^ Auth keys to permit communication with Datadog
                               , Environment -> String
environmentApiUrl :: String
                                 -- ^ The root URL for the Datadog API
                               , Environment -> Manager
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 (Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq)

instance Show Tag where
  show :: Tag -> String
show (KeyValueTag Text
k Text
v) = Text -> String
T.unpack Text
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: Text -> String
T.unpack Text
v)
  show (LabelTag Text
t) = Text -> String
T.unpack Text
t

instance Read Tag where
  readsPrec :: Int -> ReadS Tag
readsPrec Int
_ String
s = let t :: Text
t = String -> Text
T.pack String
s
                  in (\Tag
a -> [(Tag
a, String
"")]) (Tag -> [(Tag, String)]) -> Tag -> [(Tag, String)]
forall a b. (a -> b) -> a -> b
$
                     Tag -> (Int -> Tag) -> Maybe Int -> Tag
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Tag
LabelTag Text
t) (\Int
i -> (Text -> Text -> Tag) -> (Text, Text) -> Tag
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Tag
KeyValueTag (Int -> Text -> (Text, Text)
T.splitAt Int
i Text
t)) (Maybe Int -> Tag) -> Maybe Int -> Tag
forall a b. (a -> b) -> a -> b
$
                     (Char -> Bool) -> Text -> Maybe Int
T.findIndex (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') Text
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 (CheckStatus -> CheckStatus -> Bool
(CheckStatus -> CheckStatus -> Bool)
-> (CheckStatus -> CheckStatus -> Bool) -> Eq CheckStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckStatus -> CheckStatus -> Bool
$c/= :: CheckStatus -> CheckStatus -> Bool
== :: CheckStatus -> CheckStatus -> Bool
$c== :: CheckStatus -> CheckStatus -> Bool
Eq)

-- | The result of running a check on some service.
data CheckResult = CheckResult { CheckResult -> Text
checkResultCheck :: Text
                                 -- ^ Text describing the check
                               , CheckResult -> Text
checkResultHostName :: Text
                                 -- ^ Name of the host which the check applies to
                               , CheckResult -> CheckStatus
checkResultStatus :: CheckStatus
                                 -- ^ Status result of the check
                               , CheckResult -> Maybe UTCTime
checkResultTimestamp :: Maybe UTCTime
                                 -- ^ Time at which the check occurred (Nothing will wait until the
                                 -- check is sent to Datadog to compute the time)
                               , CheckResult -> Maybe Text
checkResultMessage :: Maybe Text
                                 -- ^ Information related to why this specific check run supplied
                                 -- the status it did
                               , CheckResult -> [Tag]
checkResultTags :: [Tag]
                                 -- ^ Tags to associate with this check run
                               } deriving (CheckResult -> CheckResult -> Bool
(CheckResult -> CheckResult -> Bool)
-> (CheckResult -> CheckResult -> Bool) -> Eq CheckResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckResult -> CheckResult -> Bool
$c/= :: CheckResult -> CheckResult -> Bool
== :: CheckResult -> CheckResult -> Bool
$c== :: CheckResult -> CheckResult -> Bool
Eq)

-- | A description of when downtime should occur.
data DowntimeSpec = DowntimeSpec { DowntimeSpec -> Maybe UTCTime
downtimeSpecStart :: Maybe UTCTime
                                   -- ^ When to start the downtime (or immediately)
                                 , DowntimeSpec -> Maybe UTCTime
downtimeSpecEnd :: Maybe UTCTime
                                   -- ^ When to stop the downtime (or indefinitely)
                                 , DowntimeSpec -> Maybe Text
downtimeSpecMessage :: Maybe Text
                                   -- ^ A message to include with notifications for this downtime
                                 , DowntimeSpec -> Tag
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 (DowntimeSpec -> DowntimeSpec -> Bool
(DowntimeSpec -> DowntimeSpec -> Bool)
-> (DowntimeSpec -> DowntimeSpec -> Bool) -> Eq DowntimeSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DowntimeSpec -> DowntimeSpec -> Bool
$c/= :: DowntimeSpec -> DowntimeSpec -> Bool
== :: DowntimeSpec -> DowntimeSpec -> Bool
$c== :: DowntimeSpec -> DowntimeSpec -> Bool
Eq)


-- | Datadog's internal reference to a specific donwtime instance.
type DowntimeId = Int


-- | A scheduled donwtime stored in Datadog.
data Downtime = Downtime { Downtime -> Int
downtimeId' :: DowntimeId
                           -- ^ Datadog's unique reference to the scheduled downtime
                         , Downtime -> DowntimeSpec
downtimeSpec :: DowntimeSpec
                           -- ^ Context on the downtime schedule
                         } deriving (Downtime -> Downtime -> Bool
(Downtime -> Downtime -> Bool)
-> (Downtime -> Downtime -> Bool) -> Eq Downtime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Downtime -> Downtime -> Bool
$c/= :: Downtime -> Downtime -> Bool
== :: Downtime -> Downtime -> Bool
$c== :: Downtime -> Downtime -> Bool
Eq)


-- | A set of priorities used to denote the importance of an event.
data EventPriority = NormalPriority
                   | LowPriority
                   deriving (EventPriority -> EventPriority -> Bool
(EventPriority -> EventPriority -> Bool)
-> (EventPriority -> EventPriority -> Bool) -> Eq EventPriority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventPriority -> EventPriority -> Bool
$c/= :: EventPriority -> EventPriority -> Bool
== :: EventPriority -> EventPriority -> Bool
$c== :: EventPriority -> EventPriority -> Bool
Eq)

instance Show EventPriority where
  show :: EventPriority -> String
show EventPriority
NormalPriority = String
"normal"
  show EventPriority
LowPriority = String
"low"

-- | The failure levels for an alert.
data AlertType = Error
               | Warning
               | Info
               | Success
               deriving (AlertType -> AlertType -> Bool
(AlertType -> AlertType -> Bool)
-> (AlertType -> AlertType -> Bool) -> Eq AlertType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlertType -> AlertType -> Bool
$c/= :: AlertType -> AlertType -> Bool
== :: AlertType -> AlertType -> Bool
$c== :: AlertType -> AlertType -> Bool
Eq)

instance Show AlertType where
  show :: AlertType -> String
show AlertType
Error = String
"error"
  show AlertType
Warning = String
"warning"
  show AlertType
Info = String
"info"
  show AlertType
Success = String
"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 (SourceType -> SourceType -> Bool
(SourceType -> SourceType -> Bool)
-> (SourceType -> SourceType -> Bool) -> Eq SourceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceType -> SourceType -> Bool
$c/= :: SourceType -> SourceType -> Bool
== :: SourceType -> SourceType -> Bool
$c== :: SourceType -> SourceType -> Bool
Eq)

instance Show SourceType where
  show :: SourceType -> String
show SourceType
Nagios = String
"nagios"
  show SourceType
Hudson = String
"hudson"
  show SourceType
Jenkins = String
"jenkins"
  show SourceType
User = String
"user"
  show SourceType
MyApps = String
"my apps"
  show SourceType
Feed = String
"feed"
  show SourceType
Chef = String
"chef"
  show SourceType
Puppet = String
"puppet"
  show SourceType
Git = String
"git"
  show SourceType
BitBucket = String
"bitbucket"
  show SourceType
Fabric = String
"fabric"
  show SourceType
Capistrano = String
"capistrano"

-- | Details that describe an event.
data EventSpec = EventSpec { EventSpec -> Text
eventSpecTitle :: Text
                           , EventSpec -> Text
eventSpecText :: Text
                             -- ^ The description/body of the event
                           , EventSpec -> UTCTime
eventSpecDateHappened :: UTCTime
                             -- ^ The time at which the event occurred
                           , EventSpec -> EventPriority
eventSpecPriority :: EventPriority
                           , EventSpec -> Maybe Text
eventSpecHost :: Maybe Text
                             -- ^ The hostname associated with the event
                           , EventSpec -> [Tag]
eventSpecTags :: [Tag]
                           , EventSpec -> AlertType
eventSpecAlertType :: AlertType
                           , EventSpec -> Maybe SourceType
eventSpecSourceType :: Maybe SourceType
                             -- ^ The trigger of the event (if identifiable)
                           } deriving (EventSpec -> EventSpec -> Bool
(EventSpec -> EventSpec -> Bool)
-> (EventSpec -> EventSpec -> Bool) -> Eq EventSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventSpec -> EventSpec -> Bool
$c/= :: EventSpec -> EventSpec -> Bool
== :: EventSpec -> EventSpec -> Bool
$c== :: EventSpec -> EventSpec -> Bool
Eq, Int -> EventSpec -> ShowS
[EventSpec] -> ShowS
EventSpec -> String
(Int -> EventSpec -> ShowS)
-> (EventSpec -> String)
-> ([EventSpec] -> ShowS)
-> Show EventSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventSpec] -> ShowS
$cshowList :: [EventSpec] -> ShowS
show :: EventSpec -> String
$cshow :: EventSpec -> String
showsPrec :: Int -> EventSpec -> ShowS
$cshowsPrec :: Int -> EventSpec -> ShowS
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 { Event -> Int
eventId' :: EventId
                     -- ^ Datadog's unique reference to the event
                   , Event -> EventSpec
eventDetails :: EventSpec
                     -- ^ Context on what happened during this event
                   } deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)

data WrappedEvent = WrappedEvent { WrappedEvent -> Event
wrappedEvent :: Event }

data WrappedEvents = WrappedEvents { WrappedEvents -> [Event]
wrappedEvents :: [Event] }

newtype Series = Series { Series -> DList Metric
fromSeries :: DList Metric }
                 deriving (b -> Series -> Series
NonEmpty Series -> Series
Series -> Series -> Series
(Series -> Series -> Series)
-> (NonEmpty Series -> Series)
-> (forall b. Integral b => b -> Series -> Series)
-> Semigroup Series
forall b. Integral b => b -> Series -> Series
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Series -> Series
$cstimes :: forall b. Integral b => b -> Series -> Series
sconcat :: NonEmpty Series -> Series
$csconcat :: NonEmpty Series -> Series
<> :: Series -> Series -> Series
$c<> :: Series -> Series -> Series
Semigroup, Semigroup Series
Series
Semigroup Series
-> Series
-> (Series -> Series -> Series)
-> ([Series] -> Series)
-> Monoid Series
[Series] -> Series
Series -> Series -> Series
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Series] -> Series
$cmconcat :: [Series] -> Series
mappend :: Series -> Series -> Series
$cmappend :: Series -> Series -> Series
mempty :: Series
$cmempty :: Series
$cp1Monoid :: Semigroup Series
Monoid)

data MetricPoints = Gauge   [(POSIXTime, Float)]
                  | Counter [(POSIXTime, Int64)]

data Metric = Metric
  { Metric -> Text
metricName   :: Text
  , Metric -> MetricPoints
metricPoints :: MetricPoints
  , Metric -> Maybe Text
metricHost   :: Maybe Text
  , Metric -> [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 (MonitorType -> MonitorType -> Bool
(MonitorType -> MonitorType -> Bool)
-> (MonitorType -> MonitorType -> Bool) -> Eq MonitorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorType -> MonitorType -> Bool
$c/= :: MonitorType -> MonitorType -> Bool
== :: MonitorType -> MonitorType -> Bool
$c== :: MonitorType -> MonitorType -> Bool
Eq)

instance Show MonitorType where
  show :: MonitorType -> String
show MonitorType
MetricAlert = String
"metric alert"
  show MonitorType
ServiceCheck = String
"service check"
  show MonitorType
EventAlert = String
"event alert"

-- | Advanced configuration parameters for a monitor.
data MonitorOptions = MonitorOptions { MonitorOptions -> HashMap Text (Maybe Integer)
monitorOptionsSilenced :: HashMap T.Text (Maybe Integer)
                                     , MonitorOptions -> Bool
monitorOptionsNotifyNoData :: Bool
                                     , MonitorOptions -> Maybe Integer
monitorOptionsNoDataTimeframe :: Maybe Integer
                                     , MonitorOptions -> Maybe Integer
monitorOptionsTimeoutH :: Maybe Integer
                                     , MonitorOptions -> Maybe Integer
monitorOptionsRenotifyInterval :: Maybe Integer
                                     , MonitorOptions -> Text
monitorOptionsEscalationMessage :: T.Text
                                     , MonitorOptions -> Bool
monitorOptionsNotifyAudit :: Bool
                                     } deriving (MonitorOptions -> MonitorOptions -> Bool
(MonitorOptions -> MonitorOptions -> Bool)
-> (MonitorOptions -> MonitorOptions -> Bool) -> Eq MonitorOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorOptions -> MonitorOptions -> Bool
$c/= :: MonitorOptions -> MonitorOptions -> Bool
== :: MonitorOptions -> MonitorOptions -> Bool
$c== :: MonitorOptions -> MonitorOptions -> Bool
Eq)

-- | A representation of a monitor's configuration, from which a monitor could
-- be rebuilt.
data MonitorSpec = MonitorSpec { MonitorSpec -> MonitorType
monitorSpecType' :: MonitorType
                               , MonitorSpec -> Text
monitorSpecQuery :: T.Text
                                 -- ^ The query string the monitor uses to
                                 -- determine its state.
                               , MonitorSpec -> Maybe Text
monitorSpecName :: Maybe T.Text
                                 -- ^ The human-readable name of the monitor.
                               , MonitorSpec -> Maybe Text
monitorSpecMessage :: Maybe T.Text
                                 -- ^ The message sent with the notification
                                 -- when the monitor is triggered.
                               , MonitorSpec -> MonitorOptions
monitorSpecOptions :: MonitorOptions
                                 -- ^ Optional configuration parameters
                                 -- specifying advanced monitor beahviour.
                               } deriving (MonitorSpec -> MonitorSpec -> Bool
(MonitorSpec -> MonitorSpec -> Bool)
-> (MonitorSpec -> MonitorSpec -> Bool) -> Eq MonitorSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorSpec -> MonitorSpec -> Bool
$c/= :: MonitorSpec -> MonitorSpec -> Bool
== :: MonitorSpec -> MonitorSpec -> Bool
$c== :: MonitorSpec -> MonitorSpec -> Bool
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 { Monitor -> Int
monitorId' :: MonitorId
                         -- ^ Datadog's internal reference to this specific
                         -- monitor.
                       , Monitor -> MonitorSpec
monitorSpec :: MonitorSpec
                         -- ^ The specification from which this monitor can be
                         -- re-created.
                       } deriving (Monitor -> Monitor -> Bool
(Monitor -> Monitor -> Bool)
-> (Monitor -> Monitor -> Bool) -> Eq Monitor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Monitor -> Monitor -> Bool
$c/= :: Monitor -> Monitor -> Bool
== :: Monitor -> Monitor -> Bool
$c== :: Monitor -> Monitor -> Bool
Eq)