{-# 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.CostExplorer.UpdateAnomalyMonitor
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing cost anomaly monitor. The changes made are applied
-- going forward, and doesn\'t change anomalies detected in the past.
module Amazonka.CostExplorer.UpdateAnomalyMonitor
  ( -- * Creating a Request
    UpdateAnomalyMonitor (..),
    newUpdateAnomalyMonitor,

    -- * Request Lenses
    updateAnomalyMonitor_monitorName,
    updateAnomalyMonitor_monitorArn,

    -- * Destructuring the Response
    UpdateAnomalyMonitorResponse (..),
    newUpdateAnomalyMonitorResponse,

    -- * Response Lenses
    updateAnomalyMonitorResponse_httpStatus,
    updateAnomalyMonitorResponse_monitorArn,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.CostExplorer.Types
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:/ 'newUpdateAnomalyMonitor' smart constructor.
data UpdateAnomalyMonitor = UpdateAnomalyMonitor'
  { -- | The new name for the cost anomaly monitor.
    UpdateAnomalyMonitor -> Maybe Text
monitorName :: Prelude.Maybe Prelude.Text,
    -- | Cost anomaly monitor Amazon Resource Names (ARNs).
    UpdateAnomalyMonitor -> Text
monitorArn :: Prelude.Text
  }
  deriving (UpdateAnomalyMonitor -> UpdateAnomalyMonitor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAnomalyMonitor -> UpdateAnomalyMonitor -> Bool
$c/= :: UpdateAnomalyMonitor -> UpdateAnomalyMonitor -> Bool
== :: UpdateAnomalyMonitor -> UpdateAnomalyMonitor -> Bool
$c== :: UpdateAnomalyMonitor -> UpdateAnomalyMonitor -> Bool
Prelude.Eq, ReadPrec [UpdateAnomalyMonitor]
ReadPrec UpdateAnomalyMonitor
Int -> ReadS UpdateAnomalyMonitor
ReadS [UpdateAnomalyMonitor]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAnomalyMonitor]
$creadListPrec :: ReadPrec [UpdateAnomalyMonitor]
readPrec :: ReadPrec UpdateAnomalyMonitor
$creadPrec :: ReadPrec UpdateAnomalyMonitor
readList :: ReadS [UpdateAnomalyMonitor]
$creadList :: ReadS [UpdateAnomalyMonitor]
readsPrec :: Int -> ReadS UpdateAnomalyMonitor
$creadsPrec :: Int -> ReadS UpdateAnomalyMonitor
Prelude.Read, Int -> UpdateAnomalyMonitor -> ShowS
[UpdateAnomalyMonitor] -> ShowS
UpdateAnomalyMonitor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAnomalyMonitor] -> ShowS
$cshowList :: [UpdateAnomalyMonitor] -> ShowS
show :: UpdateAnomalyMonitor -> String
$cshow :: UpdateAnomalyMonitor -> String
showsPrec :: Int -> UpdateAnomalyMonitor -> ShowS
$cshowsPrec :: Int -> UpdateAnomalyMonitor -> ShowS
Prelude.Show, forall x. Rep UpdateAnomalyMonitor x -> UpdateAnomalyMonitor
forall x. UpdateAnomalyMonitor -> Rep UpdateAnomalyMonitor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateAnomalyMonitor x -> UpdateAnomalyMonitor
$cfrom :: forall x. UpdateAnomalyMonitor -> Rep UpdateAnomalyMonitor x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAnomalyMonitor' 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:
--
-- 'monitorName', 'updateAnomalyMonitor_monitorName' - The new name for the cost anomaly monitor.
--
-- 'monitorArn', 'updateAnomalyMonitor_monitorArn' - Cost anomaly monitor Amazon Resource Names (ARNs).
newUpdateAnomalyMonitor ::
  -- | 'monitorArn'
  Prelude.Text ->
  UpdateAnomalyMonitor
newUpdateAnomalyMonitor :: Text -> UpdateAnomalyMonitor
newUpdateAnomalyMonitor Text
pMonitorArn_ =
  UpdateAnomalyMonitor'
    { $sel:monitorName:UpdateAnomalyMonitor' :: Maybe Text
monitorName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:monitorArn:UpdateAnomalyMonitor' :: Text
monitorArn = Text
pMonitorArn_
    }

-- | The new name for the cost anomaly monitor.
updateAnomalyMonitor_monitorName :: Lens.Lens' UpdateAnomalyMonitor (Prelude.Maybe Prelude.Text)
updateAnomalyMonitor_monitorName :: Lens' UpdateAnomalyMonitor (Maybe Text)
updateAnomalyMonitor_monitorName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAnomalyMonitor' {Maybe Text
monitorName :: Maybe Text
$sel:monitorName:UpdateAnomalyMonitor' :: UpdateAnomalyMonitor -> Maybe Text
monitorName} -> Maybe Text
monitorName) (\s :: UpdateAnomalyMonitor
s@UpdateAnomalyMonitor' {} Maybe Text
a -> UpdateAnomalyMonitor
s {$sel:monitorName:UpdateAnomalyMonitor' :: Maybe Text
monitorName = Maybe Text
a} :: UpdateAnomalyMonitor)

-- | Cost anomaly monitor Amazon Resource Names (ARNs).
updateAnomalyMonitor_monitorArn :: Lens.Lens' UpdateAnomalyMonitor Prelude.Text
updateAnomalyMonitor_monitorArn :: Lens' UpdateAnomalyMonitor Text
updateAnomalyMonitor_monitorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAnomalyMonitor' {Text
monitorArn :: Text
$sel:monitorArn:UpdateAnomalyMonitor' :: UpdateAnomalyMonitor -> Text
monitorArn} -> Text
monitorArn) (\s :: UpdateAnomalyMonitor
s@UpdateAnomalyMonitor' {} Text
a -> UpdateAnomalyMonitor
s {$sel:monitorArn:UpdateAnomalyMonitor' :: Text
monitorArn = Text
a} :: UpdateAnomalyMonitor)

instance Core.AWSRequest UpdateAnomalyMonitor where
  type
    AWSResponse UpdateAnomalyMonitor =
      UpdateAnomalyMonitorResponse
  request :: (Service -> Service)
-> UpdateAnomalyMonitor -> Request UpdateAnomalyMonitor
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateAnomalyMonitor
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateAnomalyMonitor)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Text -> UpdateAnomalyMonitorResponse
UpdateAnomalyMonitorResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"MonitorArn")
      )

instance Prelude.Hashable UpdateAnomalyMonitor where
  hashWithSalt :: Int -> UpdateAnomalyMonitor -> Int
hashWithSalt Int
_salt UpdateAnomalyMonitor' {Maybe Text
Text
monitorArn :: Text
monitorName :: Maybe Text
$sel:monitorArn:UpdateAnomalyMonitor' :: UpdateAnomalyMonitor -> Text
$sel:monitorName:UpdateAnomalyMonitor' :: UpdateAnomalyMonitor -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
monitorName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
monitorArn

instance Prelude.NFData UpdateAnomalyMonitor where
  rnf :: UpdateAnomalyMonitor -> ()
rnf UpdateAnomalyMonitor' {Maybe Text
Text
monitorArn :: Text
monitorName :: Maybe Text
$sel:monitorArn:UpdateAnomalyMonitor' :: UpdateAnomalyMonitor -> Text
$sel:monitorName:UpdateAnomalyMonitor' :: UpdateAnomalyMonitor -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
monitorName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
monitorArn

instance Data.ToHeaders UpdateAnomalyMonitor where
  toHeaders :: UpdateAnomalyMonitor -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AWSInsightsIndexService.UpdateAnomalyMonitor" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateAnomalyMonitor where
  toJSON :: UpdateAnomalyMonitor -> Value
toJSON UpdateAnomalyMonitor' {Maybe Text
Text
monitorArn :: Text
monitorName :: Maybe Text
$sel:monitorArn:UpdateAnomalyMonitor' :: UpdateAnomalyMonitor -> Text
$sel:monitorName:UpdateAnomalyMonitor' :: UpdateAnomalyMonitor -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MonitorName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
monitorName,
            forall a. a -> Maybe a
Prelude.Just (Key
"MonitorArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
monitorArn)
          ]
      )

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

instance Data.ToQuery UpdateAnomalyMonitor where
  toQuery :: UpdateAnomalyMonitor -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

-- |
-- Create a value of 'UpdateAnomalyMonitorResponse' 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', 'updateAnomalyMonitorResponse_httpStatus' - The response's http status code.
--
-- 'monitorArn', 'updateAnomalyMonitorResponse_monitorArn' - A cost anomaly monitor ARN.
newUpdateAnomalyMonitorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'monitorArn'
  Prelude.Text ->
  UpdateAnomalyMonitorResponse
newUpdateAnomalyMonitorResponse :: Int -> Text -> UpdateAnomalyMonitorResponse
newUpdateAnomalyMonitorResponse
  Int
pHttpStatus_
  Text
pMonitorArn_ =
    UpdateAnomalyMonitorResponse'
      { $sel:httpStatus:UpdateAnomalyMonitorResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:monitorArn:UpdateAnomalyMonitorResponse' :: Text
monitorArn = Text
pMonitorArn_
      }

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

-- | A cost anomaly monitor ARN.
updateAnomalyMonitorResponse_monitorArn :: Lens.Lens' UpdateAnomalyMonitorResponse Prelude.Text
updateAnomalyMonitorResponse_monitorArn :: Lens' UpdateAnomalyMonitorResponse Text
updateAnomalyMonitorResponse_monitorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAnomalyMonitorResponse' {Text
monitorArn :: Text
$sel:monitorArn:UpdateAnomalyMonitorResponse' :: UpdateAnomalyMonitorResponse -> Text
monitorArn} -> Text
monitorArn) (\s :: UpdateAnomalyMonitorResponse
s@UpdateAnomalyMonitorResponse' {} Text
a -> UpdateAnomalyMonitorResponse
s {$sel:monitorArn:UpdateAnomalyMonitorResponse' :: Text
monitorArn = Text
a} :: UpdateAnomalyMonitorResponse)

instance Prelude.NFData UpdateAnomalyMonitorResponse where
  rnf :: UpdateAnomalyMonitorResponse -> ()
rnf UpdateAnomalyMonitorResponse' {Int
Text
monitorArn :: Text
httpStatus :: Int
$sel:monitorArn:UpdateAnomalyMonitorResponse' :: UpdateAnomalyMonitorResponse -> Text
$sel:httpStatus:UpdateAnomalyMonitorResponse' :: UpdateAnomalyMonitorResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
monitorArn