{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.CloudWatch.PutAnomalyDetector
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an anomaly detection model for a CloudWatch metric. You can use
-- the model to display a band of expected normal values when the metric is
-- graphed.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch_Anomaly_Detection.html CloudWatch Anomaly Detection>.
module Amazonka.CloudWatch.PutAnomalyDetector
  ( -- * Creating a Request
    PutAnomalyDetector (..),
    newPutAnomalyDetector,

    -- * Request Lenses
    putAnomalyDetector_configuration,
    putAnomalyDetector_dimensions,
    putAnomalyDetector_metricMathAnomalyDetector,
    putAnomalyDetector_metricName,
    putAnomalyDetector_namespace,
    putAnomalyDetector_singleMetricAnomalyDetector,
    putAnomalyDetector_stat,

    -- * Destructuring the Response
    PutAnomalyDetectorResponse (..),
    newPutAnomalyDetectorResponse,

    -- * Response Lenses
    putAnomalyDetectorResponse_httpStatus,
  )
where

import Amazonka.CloudWatch.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newPutAnomalyDetector' smart constructor.
data PutAnomalyDetector = PutAnomalyDetector'
  { -- | The configuration specifies details about how the anomaly detection
    -- model is to be trained, including time ranges to exclude when training
    -- and updating the model. You can specify as many as 10 time ranges.
    --
    -- The configuration can also include the time zone to use for the metric.
    PutAnomalyDetector -> Maybe AnomalyDetectorConfiguration
configuration :: Prelude.Maybe AnomalyDetectorConfiguration,
    -- | The metric dimensions to create the anomaly detection model for.
    PutAnomalyDetector -> Maybe [Dimension]
dimensions :: Prelude.Maybe [Dimension],
    -- | The metric math anomaly detector to be created.
    --
    -- When using @MetricMathAnomalyDetector@, you cannot include the following
    -- parameters in the same operation:
    --
    -- -   @Dimensions@
    --
    -- -   @MetricName@
    --
    -- -   @Namespace@
    --
    -- -   @Stat@
    --
    -- -   the @SingleMetricAnomalyDetector@ parameters of
    --     @PutAnomalyDetectorInput@
    --
    -- Instead, specify the metric math anomaly detector attributes as part of
    -- the property @MetricMathAnomalyDetector@.
    PutAnomalyDetector -> Maybe MetricMathAnomalyDetector
metricMathAnomalyDetector :: Prelude.Maybe MetricMathAnomalyDetector,
    -- | The name of the metric to create the anomaly detection model for.
    PutAnomalyDetector -> Maybe Text
metricName :: Prelude.Maybe Prelude.Text,
    -- | The namespace of the metric to create the anomaly detection model for.
    PutAnomalyDetector -> Maybe Text
namespace :: Prelude.Maybe Prelude.Text,
    -- | A single metric anomaly detector to be created.
    --
    -- When using @SingleMetricAnomalyDetector@, you cannot include the
    -- following parameters in the same operation:
    --
    -- -   @Dimensions@
    --
    -- -   @MetricName@
    --
    -- -   @Namespace@
    --
    -- -   @Stat@
    --
    -- -   the @MetricMatchAnomalyDetector@ parameters of
    --     @PutAnomalyDetectorInput@
    --
    -- Instead, specify the single metric anomaly detector attributes as part
    -- of the property @SingleMetricAnomalyDetector@.
    PutAnomalyDetector -> Maybe SingleMetricAnomalyDetector
singleMetricAnomalyDetector :: Prelude.Maybe SingleMetricAnomalyDetector,
    -- | The statistic to use for the metric and the anomaly detection model.
    PutAnomalyDetector -> Maybe Text
stat :: Prelude.Maybe Prelude.Text
  }
  deriving (PutAnomalyDetector -> PutAnomalyDetector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutAnomalyDetector -> PutAnomalyDetector -> Bool
$c/= :: PutAnomalyDetector -> PutAnomalyDetector -> Bool
== :: PutAnomalyDetector -> PutAnomalyDetector -> Bool
$c== :: PutAnomalyDetector -> PutAnomalyDetector -> Bool
Prelude.Eq, ReadPrec [PutAnomalyDetector]
ReadPrec PutAnomalyDetector
Int -> ReadS PutAnomalyDetector
ReadS [PutAnomalyDetector]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutAnomalyDetector]
$creadListPrec :: ReadPrec [PutAnomalyDetector]
readPrec :: ReadPrec PutAnomalyDetector
$creadPrec :: ReadPrec PutAnomalyDetector
readList :: ReadS [PutAnomalyDetector]
$creadList :: ReadS [PutAnomalyDetector]
readsPrec :: Int -> ReadS PutAnomalyDetector
$creadsPrec :: Int -> ReadS PutAnomalyDetector
Prelude.Read, Int -> PutAnomalyDetector -> ShowS
[PutAnomalyDetector] -> ShowS
PutAnomalyDetector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutAnomalyDetector] -> ShowS
$cshowList :: [PutAnomalyDetector] -> ShowS
show :: PutAnomalyDetector -> String
$cshow :: PutAnomalyDetector -> String
showsPrec :: Int -> PutAnomalyDetector -> ShowS
$cshowsPrec :: Int -> PutAnomalyDetector -> ShowS
Prelude.Show, forall x. Rep PutAnomalyDetector x -> PutAnomalyDetector
forall x. PutAnomalyDetector -> Rep PutAnomalyDetector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutAnomalyDetector x -> PutAnomalyDetector
$cfrom :: forall x. PutAnomalyDetector -> Rep PutAnomalyDetector x
Prelude.Generic)

-- |
-- Create a value of 'PutAnomalyDetector' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'configuration', 'putAnomalyDetector_configuration' - The configuration specifies details about how the anomaly detection
-- model is to be trained, including time ranges to exclude when training
-- and updating the model. You can specify as many as 10 time ranges.
--
-- The configuration can also include the time zone to use for the metric.
--
-- 'dimensions', 'putAnomalyDetector_dimensions' - The metric dimensions to create the anomaly detection model for.
--
-- 'metricMathAnomalyDetector', 'putAnomalyDetector_metricMathAnomalyDetector' - The metric math anomaly detector to be created.
--
-- When using @MetricMathAnomalyDetector@, you cannot include the following
-- parameters in the same operation:
--
-- -   @Dimensions@
--
-- -   @MetricName@
--
-- -   @Namespace@
--
-- -   @Stat@
--
-- -   the @SingleMetricAnomalyDetector@ parameters of
--     @PutAnomalyDetectorInput@
--
-- Instead, specify the metric math anomaly detector attributes as part of
-- the property @MetricMathAnomalyDetector@.
--
-- 'metricName', 'putAnomalyDetector_metricName' - The name of the metric to create the anomaly detection model for.
--
-- 'namespace', 'putAnomalyDetector_namespace' - The namespace of the metric to create the anomaly detection model for.
--
-- 'singleMetricAnomalyDetector', 'putAnomalyDetector_singleMetricAnomalyDetector' - A single metric anomaly detector to be created.
--
-- When using @SingleMetricAnomalyDetector@, you cannot include the
-- following parameters in the same operation:
--
-- -   @Dimensions@
--
-- -   @MetricName@
--
-- -   @Namespace@
--
-- -   @Stat@
--
-- -   the @MetricMatchAnomalyDetector@ parameters of
--     @PutAnomalyDetectorInput@
--
-- Instead, specify the single metric anomaly detector attributes as part
-- of the property @SingleMetricAnomalyDetector@.
--
-- 'stat', 'putAnomalyDetector_stat' - The statistic to use for the metric and the anomaly detection model.
newPutAnomalyDetector ::
  PutAnomalyDetector
newPutAnomalyDetector :: PutAnomalyDetector
newPutAnomalyDetector =
  PutAnomalyDetector'
    { $sel:configuration:PutAnomalyDetector' :: Maybe AnomalyDetectorConfiguration
configuration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dimensions:PutAnomalyDetector' :: Maybe [Dimension]
dimensions = forall a. Maybe a
Prelude.Nothing,
      $sel:metricMathAnomalyDetector:PutAnomalyDetector' :: Maybe MetricMathAnomalyDetector
metricMathAnomalyDetector = forall a. Maybe a
Prelude.Nothing,
      $sel:metricName:PutAnomalyDetector' :: Maybe Text
metricName = forall a. Maybe a
Prelude.Nothing,
      $sel:namespace:PutAnomalyDetector' :: Maybe Text
namespace = forall a. Maybe a
Prelude.Nothing,
      $sel:singleMetricAnomalyDetector:PutAnomalyDetector' :: Maybe SingleMetricAnomalyDetector
singleMetricAnomalyDetector = forall a. Maybe a
Prelude.Nothing,
      $sel:stat:PutAnomalyDetector' :: Maybe Text
stat = forall a. Maybe a
Prelude.Nothing
    }

-- | The configuration specifies details about how the anomaly detection
-- model is to be trained, including time ranges to exclude when training
-- and updating the model. You can specify as many as 10 time ranges.
--
-- The configuration can also include the time zone to use for the metric.
putAnomalyDetector_configuration :: Lens.Lens' PutAnomalyDetector (Prelude.Maybe AnomalyDetectorConfiguration)
putAnomalyDetector_configuration :: Lens' PutAnomalyDetector (Maybe AnomalyDetectorConfiguration)
putAnomalyDetector_configuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAnomalyDetector' {Maybe AnomalyDetectorConfiguration
configuration :: Maybe AnomalyDetectorConfiguration
$sel:configuration:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe AnomalyDetectorConfiguration
configuration} -> Maybe AnomalyDetectorConfiguration
configuration) (\s :: PutAnomalyDetector
s@PutAnomalyDetector' {} Maybe AnomalyDetectorConfiguration
a -> PutAnomalyDetector
s {$sel:configuration:PutAnomalyDetector' :: Maybe AnomalyDetectorConfiguration
configuration = Maybe AnomalyDetectorConfiguration
a} :: PutAnomalyDetector)

-- | The metric dimensions to create the anomaly detection model for.
putAnomalyDetector_dimensions :: Lens.Lens' PutAnomalyDetector (Prelude.Maybe [Dimension])
putAnomalyDetector_dimensions :: Lens' PutAnomalyDetector (Maybe [Dimension])
putAnomalyDetector_dimensions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAnomalyDetector' {Maybe [Dimension]
dimensions :: Maybe [Dimension]
$sel:dimensions:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe [Dimension]
dimensions} -> Maybe [Dimension]
dimensions) (\s :: PutAnomalyDetector
s@PutAnomalyDetector' {} Maybe [Dimension]
a -> PutAnomalyDetector
s {$sel:dimensions:PutAnomalyDetector' :: Maybe [Dimension]
dimensions = Maybe [Dimension]
a} :: PutAnomalyDetector) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The metric math anomaly detector to be created.
--
-- When using @MetricMathAnomalyDetector@, you cannot include the following
-- parameters in the same operation:
--
-- -   @Dimensions@
--
-- -   @MetricName@
--
-- -   @Namespace@
--
-- -   @Stat@
--
-- -   the @SingleMetricAnomalyDetector@ parameters of
--     @PutAnomalyDetectorInput@
--
-- Instead, specify the metric math anomaly detector attributes as part of
-- the property @MetricMathAnomalyDetector@.
putAnomalyDetector_metricMathAnomalyDetector :: Lens.Lens' PutAnomalyDetector (Prelude.Maybe MetricMathAnomalyDetector)
putAnomalyDetector_metricMathAnomalyDetector :: Lens' PutAnomalyDetector (Maybe MetricMathAnomalyDetector)
putAnomalyDetector_metricMathAnomalyDetector = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAnomalyDetector' {Maybe MetricMathAnomalyDetector
metricMathAnomalyDetector :: Maybe MetricMathAnomalyDetector
$sel:metricMathAnomalyDetector:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe MetricMathAnomalyDetector
metricMathAnomalyDetector} -> Maybe MetricMathAnomalyDetector
metricMathAnomalyDetector) (\s :: PutAnomalyDetector
s@PutAnomalyDetector' {} Maybe MetricMathAnomalyDetector
a -> PutAnomalyDetector
s {$sel:metricMathAnomalyDetector:PutAnomalyDetector' :: Maybe MetricMathAnomalyDetector
metricMathAnomalyDetector = Maybe MetricMathAnomalyDetector
a} :: PutAnomalyDetector)

-- | The name of the metric to create the anomaly detection model for.
putAnomalyDetector_metricName :: Lens.Lens' PutAnomalyDetector (Prelude.Maybe Prelude.Text)
putAnomalyDetector_metricName :: Lens' PutAnomalyDetector (Maybe Text)
putAnomalyDetector_metricName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAnomalyDetector' {Maybe Text
metricName :: Maybe Text
$sel:metricName:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe Text
metricName} -> Maybe Text
metricName) (\s :: PutAnomalyDetector
s@PutAnomalyDetector' {} Maybe Text
a -> PutAnomalyDetector
s {$sel:metricName:PutAnomalyDetector' :: Maybe Text
metricName = Maybe Text
a} :: PutAnomalyDetector)

-- | The namespace of the metric to create the anomaly detection model for.
putAnomalyDetector_namespace :: Lens.Lens' PutAnomalyDetector (Prelude.Maybe Prelude.Text)
putAnomalyDetector_namespace :: Lens' PutAnomalyDetector (Maybe Text)
putAnomalyDetector_namespace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAnomalyDetector' {Maybe Text
namespace :: Maybe Text
$sel:namespace:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe Text
namespace} -> Maybe Text
namespace) (\s :: PutAnomalyDetector
s@PutAnomalyDetector' {} Maybe Text
a -> PutAnomalyDetector
s {$sel:namespace:PutAnomalyDetector' :: Maybe Text
namespace = Maybe Text
a} :: PutAnomalyDetector)

-- | A single metric anomaly detector to be created.
--
-- When using @SingleMetricAnomalyDetector@, you cannot include the
-- following parameters in the same operation:
--
-- -   @Dimensions@
--
-- -   @MetricName@
--
-- -   @Namespace@
--
-- -   @Stat@
--
-- -   the @MetricMatchAnomalyDetector@ parameters of
--     @PutAnomalyDetectorInput@
--
-- Instead, specify the single metric anomaly detector attributes as part
-- of the property @SingleMetricAnomalyDetector@.
putAnomalyDetector_singleMetricAnomalyDetector :: Lens.Lens' PutAnomalyDetector (Prelude.Maybe SingleMetricAnomalyDetector)
putAnomalyDetector_singleMetricAnomalyDetector :: Lens' PutAnomalyDetector (Maybe SingleMetricAnomalyDetector)
putAnomalyDetector_singleMetricAnomalyDetector = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAnomalyDetector' {Maybe SingleMetricAnomalyDetector
singleMetricAnomalyDetector :: Maybe SingleMetricAnomalyDetector
$sel:singleMetricAnomalyDetector:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe SingleMetricAnomalyDetector
singleMetricAnomalyDetector} -> Maybe SingleMetricAnomalyDetector
singleMetricAnomalyDetector) (\s :: PutAnomalyDetector
s@PutAnomalyDetector' {} Maybe SingleMetricAnomalyDetector
a -> PutAnomalyDetector
s {$sel:singleMetricAnomalyDetector:PutAnomalyDetector' :: Maybe SingleMetricAnomalyDetector
singleMetricAnomalyDetector = Maybe SingleMetricAnomalyDetector
a} :: PutAnomalyDetector)

-- | The statistic to use for the metric and the anomaly detection model.
putAnomalyDetector_stat :: Lens.Lens' PutAnomalyDetector (Prelude.Maybe Prelude.Text)
putAnomalyDetector_stat :: Lens' PutAnomalyDetector (Maybe Text)
putAnomalyDetector_stat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAnomalyDetector' {Maybe Text
stat :: Maybe Text
$sel:stat:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe Text
stat} -> Maybe Text
stat) (\s :: PutAnomalyDetector
s@PutAnomalyDetector' {} Maybe Text
a -> PutAnomalyDetector
s {$sel:stat:PutAnomalyDetector' :: Maybe Text
stat = Maybe Text
a} :: PutAnomalyDetector)

instance Core.AWSRequest PutAnomalyDetector where
  type
    AWSResponse PutAnomalyDetector =
      PutAnomalyDetectorResponse
  request :: (Service -> Service)
-> PutAnomalyDetector -> Request PutAnomalyDetector
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutAnomalyDetector
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutAnomalyDetector)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"PutAnomalyDetectorResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> PutAnomalyDetectorResponse
PutAnomalyDetectorResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable PutAnomalyDetector where
  hashWithSalt :: Int -> PutAnomalyDetector -> Int
hashWithSalt Int
_salt PutAnomalyDetector' {Maybe [Dimension]
Maybe Text
Maybe AnomalyDetectorConfiguration
Maybe SingleMetricAnomalyDetector
Maybe MetricMathAnomalyDetector
stat :: Maybe Text
singleMetricAnomalyDetector :: Maybe SingleMetricAnomalyDetector
namespace :: Maybe Text
metricName :: Maybe Text
metricMathAnomalyDetector :: Maybe MetricMathAnomalyDetector
dimensions :: Maybe [Dimension]
configuration :: Maybe AnomalyDetectorConfiguration
$sel:stat:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe Text
$sel:singleMetricAnomalyDetector:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe SingleMetricAnomalyDetector
$sel:namespace:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe Text
$sel:metricName:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe Text
$sel:metricMathAnomalyDetector:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe MetricMathAnomalyDetector
$sel:dimensions:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe [Dimension]
$sel:configuration:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe AnomalyDetectorConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AnomalyDetectorConfiguration
configuration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Dimension]
dimensions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MetricMathAnomalyDetector
metricMathAnomalyDetector
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
metricName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
namespace
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SingleMetricAnomalyDetector
singleMetricAnomalyDetector
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stat

instance Prelude.NFData PutAnomalyDetector where
  rnf :: PutAnomalyDetector -> ()
rnf PutAnomalyDetector' {Maybe [Dimension]
Maybe Text
Maybe AnomalyDetectorConfiguration
Maybe SingleMetricAnomalyDetector
Maybe MetricMathAnomalyDetector
stat :: Maybe Text
singleMetricAnomalyDetector :: Maybe SingleMetricAnomalyDetector
namespace :: Maybe Text
metricName :: Maybe Text
metricMathAnomalyDetector :: Maybe MetricMathAnomalyDetector
dimensions :: Maybe [Dimension]
configuration :: Maybe AnomalyDetectorConfiguration
$sel:stat:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe Text
$sel:singleMetricAnomalyDetector:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe SingleMetricAnomalyDetector
$sel:namespace:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe Text
$sel:metricName:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe Text
$sel:metricMathAnomalyDetector:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe MetricMathAnomalyDetector
$sel:dimensions:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe [Dimension]
$sel:configuration:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe AnomalyDetectorConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AnomalyDetectorConfiguration
configuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Dimension]
dimensions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MetricMathAnomalyDetector
metricMathAnomalyDetector
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
metricName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
namespace
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SingleMetricAnomalyDetector
singleMetricAnomalyDetector
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stat

instance Data.ToHeaders PutAnomalyDetector where
  toHeaders :: PutAnomalyDetector -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath PutAnomalyDetector where
  toPath :: PutAnomalyDetector -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery PutAnomalyDetector where
  toQuery :: PutAnomalyDetector -> QueryString
toQuery PutAnomalyDetector' {Maybe [Dimension]
Maybe Text
Maybe AnomalyDetectorConfiguration
Maybe SingleMetricAnomalyDetector
Maybe MetricMathAnomalyDetector
stat :: Maybe Text
singleMetricAnomalyDetector :: Maybe SingleMetricAnomalyDetector
namespace :: Maybe Text
metricName :: Maybe Text
metricMathAnomalyDetector :: Maybe MetricMathAnomalyDetector
dimensions :: Maybe [Dimension]
configuration :: Maybe AnomalyDetectorConfiguration
$sel:stat:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe Text
$sel:singleMetricAnomalyDetector:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe SingleMetricAnomalyDetector
$sel:namespace:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe Text
$sel:metricName:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe Text
$sel:metricMathAnomalyDetector:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe MetricMathAnomalyDetector
$sel:dimensions:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe [Dimension]
$sel:configuration:PutAnomalyDetector' :: PutAnomalyDetector -> Maybe AnomalyDetectorConfiguration
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"PutAnomalyDetector" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-08-01" :: Prelude.ByteString),
        ByteString
"Configuration" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AnomalyDetectorConfiguration
configuration,
        ByteString
"Dimensions"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Dimension]
dimensions),
        ByteString
"MetricMathAnomalyDetector"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe MetricMathAnomalyDetector
metricMathAnomalyDetector,
        ByteString
"MetricName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
metricName,
        ByteString
"Namespace" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
namespace,
        ByteString
"SingleMetricAnomalyDetector"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SingleMetricAnomalyDetector
singleMetricAnomalyDetector,
        ByteString
"Stat" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
stat
      ]

-- | /See:/ 'newPutAnomalyDetectorResponse' smart constructor.
data PutAnomalyDetectorResponse = PutAnomalyDetectorResponse'
  { -- | The response's http status code.
    PutAnomalyDetectorResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutAnomalyDetectorResponse -> PutAnomalyDetectorResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutAnomalyDetectorResponse -> PutAnomalyDetectorResponse -> Bool
$c/= :: PutAnomalyDetectorResponse -> PutAnomalyDetectorResponse -> Bool
== :: PutAnomalyDetectorResponse -> PutAnomalyDetectorResponse -> Bool
$c== :: PutAnomalyDetectorResponse -> PutAnomalyDetectorResponse -> Bool
Prelude.Eq, ReadPrec [PutAnomalyDetectorResponse]
ReadPrec PutAnomalyDetectorResponse
Int -> ReadS PutAnomalyDetectorResponse
ReadS [PutAnomalyDetectorResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutAnomalyDetectorResponse]
$creadListPrec :: ReadPrec [PutAnomalyDetectorResponse]
readPrec :: ReadPrec PutAnomalyDetectorResponse
$creadPrec :: ReadPrec PutAnomalyDetectorResponse
readList :: ReadS [PutAnomalyDetectorResponse]
$creadList :: ReadS [PutAnomalyDetectorResponse]
readsPrec :: Int -> ReadS PutAnomalyDetectorResponse
$creadsPrec :: Int -> ReadS PutAnomalyDetectorResponse
Prelude.Read, Int -> PutAnomalyDetectorResponse -> ShowS
[PutAnomalyDetectorResponse] -> ShowS
PutAnomalyDetectorResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutAnomalyDetectorResponse] -> ShowS
$cshowList :: [PutAnomalyDetectorResponse] -> ShowS
show :: PutAnomalyDetectorResponse -> String
$cshow :: PutAnomalyDetectorResponse -> String
showsPrec :: Int -> PutAnomalyDetectorResponse -> ShowS
$cshowsPrec :: Int -> PutAnomalyDetectorResponse -> ShowS
Prelude.Show, forall x.
Rep PutAnomalyDetectorResponse x -> PutAnomalyDetectorResponse
forall x.
PutAnomalyDetectorResponse -> Rep PutAnomalyDetectorResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutAnomalyDetectorResponse x -> PutAnomalyDetectorResponse
$cfrom :: forall x.
PutAnomalyDetectorResponse -> Rep PutAnomalyDetectorResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutAnomalyDetectorResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'putAnomalyDetectorResponse_httpStatus' - The response's http status code.
newPutAnomalyDetectorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutAnomalyDetectorResponse
newPutAnomalyDetectorResponse :: Int -> PutAnomalyDetectorResponse
newPutAnomalyDetectorResponse Int
pHttpStatus_ =
  PutAnomalyDetectorResponse'
    { $sel:httpStatus:PutAnomalyDetectorResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

-- | The response's http status code.
putAnomalyDetectorResponse_httpStatus :: Lens.Lens' PutAnomalyDetectorResponse Prelude.Int
putAnomalyDetectorResponse_httpStatus :: Lens' PutAnomalyDetectorResponse Int
putAnomalyDetectorResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAnomalyDetectorResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutAnomalyDetectorResponse' :: PutAnomalyDetectorResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: PutAnomalyDetectorResponse
s@PutAnomalyDetectorResponse' {} Int
a -> PutAnomalyDetectorResponse
s {$sel:httpStatus:PutAnomalyDetectorResponse' :: Int
httpStatus = Int
a} :: PutAnomalyDetectorResponse)

instance Prelude.NFData PutAnomalyDetectorResponse where
  rnf :: PutAnomalyDetectorResponse -> ()
rnf PutAnomalyDetectorResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutAnomalyDetectorResponse' :: PutAnomalyDetectorResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus