{-# 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.UpdateCostAllocationTagsStatus
-- 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 status for cost allocation tags in bulk, with maximum batch size
-- of 20. If the tag status that\'s updated is the same as the existing tag
-- status, the request doesn\'t fail. Instead, it doesn\'t have any effect
-- on the tag status (for example, activating the active tag).
module Amazonka.CostExplorer.UpdateCostAllocationTagsStatus
  ( -- * Creating a Request
    UpdateCostAllocationTagsStatus (..),
    newUpdateCostAllocationTagsStatus,

    -- * Request Lenses
    updateCostAllocationTagsStatus_costAllocationTagsStatus,

    -- * Destructuring the Response
    UpdateCostAllocationTagsStatusResponse (..),
    newUpdateCostAllocationTagsStatusResponse,

    -- * Response Lenses
    updateCostAllocationTagsStatusResponse_errors,
    updateCostAllocationTagsStatusResponse_httpStatus,
  )
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:/ 'newUpdateCostAllocationTagsStatus' smart constructor.
data UpdateCostAllocationTagsStatus = UpdateCostAllocationTagsStatus'
  { -- | The list of @CostAllocationTagStatusEntry@ objects that are used to
    -- update cost allocation tags status for this request.
    UpdateCostAllocationTagsStatus
-> NonEmpty CostAllocationTagStatusEntry
costAllocationTagsStatus :: Prelude.NonEmpty CostAllocationTagStatusEntry
  }
  deriving (UpdateCostAllocationTagsStatus
-> UpdateCostAllocationTagsStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCostAllocationTagsStatus
-> UpdateCostAllocationTagsStatus -> Bool
$c/= :: UpdateCostAllocationTagsStatus
-> UpdateCostAllocationTagsStatus -> Bool
== :: UpdateCostAllocationTagsStatus
-> UpdateCostAllocationTagsStatus -> Bool
$c== :: UpdateCostAllocationTagsStatus
-> UpdateCostAllocationTagsStatus -> Bool
Prelude.Eq, ReadPrec [UpdateCostAllocationTagsStatus]
ReadPrec UpdateCostAllocationTagsStatus
Int -> ReadS UpdateCostAllocationTagsStatus
ReadS [UpdateCostAllocationTagsStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCostAllocationTagsStatus]
$creadListPrec :: ReadPrec [UpdateCostAllocationTagsStatus]
readPrec :: ReadPrec UpdateCostAllocationTagsStatus
$creadPrec :: ReadPrec UpdateCostAllocationTagsStatus
readList :: ReadS [UpdateCostAllocationTagsStatus]
$creadList :: ReadS [UpdateCostAllocationTagsStatus]
readsPrec :: Int -> ReadS UpdateCostAllocationTagsStatus
$creadsPrec :: Int -> ReadS UpdateCostAllocationTagsStatus
Prelude.Read, Int -> UpdateCostAllocationTagsStatus -> ShowS
[UpdateCostAllocationTagsStatus] -> ShowS
UpdateCostAllocationTagsStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCostAllocationTagsStatus] -> ShowS
$cshowList :: [UpdateCostAllocationTagsStatus] -> ShowS
show :: UpdateCostAllocationTagsStatus -> String
$cshow :: UpdateCostAllocationTagsStatus -> String
showsPrec :: Int -> UpdateCostAllocationTagsStatus -> ShowS
$cshowsPrec :: Int -> UpdateCostAllocationTagsStatus -> ShowS
Prelude.Show, forall x.
Rep UpdateCostAllocationTagsStatus x
-> UpdateCostAllocationTagsStatus
forall x.
UpdateCostAllocationTagsStatus
-> Rep UpdateCostAllocationTagsStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateCostAllocationTagsStatus x
-> UpdateCostAllocationTagsStatus
$cfrom :: forall x.
UpdateCostAllocationTagsStatus
-> Rep UpdateCostAllocationTagsStatus x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCostAllocationTagsStatus' 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:
--
-- 'costAllocationTagsStatus', 'updateCostAllocationTagsStatus_costAllocationTagsStatus' - The list of @CostAllocationTagStatusEntry@ objects that are used to
-- update cost allocation tags status for this request.
newUpdateCostAllocationTagsStatus ::
  -- | 'costAllocationTagsStatus'
  Prelude.NonEmpty CostAllocationTagStatusEntry ->
  UpdateCostAllocationTagsStatus
newUpdateCostAllocationTagsStatus :: NonEmpty CostAllocationTagStatusEntry
-> UpdateCostAllocationTagsStatus
newUpdateCostAllocationTagsStatus
  NonEmpty CostAllocationTagStatusEntry
pCostAllocationTagsStatus_ =
    UpdateCostAllocationTagsStatus'
      { $sel:costAllocationTagsStatus:UpdateCostAllocationTagsStatus' :: NonEmpty CostAllocationTagStatusEntry
costAllocationTagsStatus =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced
            forall t b. AReview t b -> b -> t
Lens.# NonEmpty CostAllocationTagStatusEntry
pCostAllocationTagsStatus_
      }

-- | The list of @CostAllocationTagStatusEntry@ objects that are used to
-- update cost allocation tags status for this request.
updateCostAllocationTagsStatus_costAllocationTagsStatus :: Lens.Lens' UpdateCostAllocationTagsStatus (Prelude.NonEmpty CostAllocationTagStatusEntry)
updateCostAllocationTagsStatus_costAllocationTagsStatus :: Lens'
  UpdateCostAllocationTagsStatus
  (NonEmpty CostAllocationTagStatusEntry)
updateCostAllocationTagsStatus_costAllocationTagsStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCostAllocationTagsStatus' {NonEmpty CostAllocationTagStatusEntry
costAllocationTagsStatus :: NonEmpty CostAllocationTagStatusEntry
$sel:costAllocationTagsStatus:UpdateCostAllocationTagsStatus' :: UpdateCostAllocationTagsStatus
-> NonEmpty CostAllocationTagStatusEntry
costAllocationTagsStatus} -> NonEmpty CostAllocationTagStatusEntry
costAllocationTagsStatus) (\s :: UpdateCostAllocationTagsStatus
s@UpdateCostAllocationTagsStatus' {} NonEmpty CostAllocationTagStatusEntry
a -> UpdateCostAllocationTagsStatus
s {$sel:costAllocationTagsStatus:UpdateCostAllocationTagsStatus' :: NonEmpty CostAllocationTagStatusEntry
costAllocationTagsStatus = NonEmpty CostAllocationTagStatusEntry
a} :: UpdateCostAllocationTagsStatus) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance
  Core.AWSRequest
    UpdateCostAllocationTagsStatus
  where
  type
    AWSResponse UpdateCostAllocationTagsStatus =
      UpdateCostAllocationTagsStatusResponse
  request :: (Service -> Service)
-> UpdateCostAllocationTagsStatus
-> Request UpdateCostAllocationTagsStatus
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 UpdateCostAllocationTagsStatus
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse UpdateCostAllocationTagsStatus)))
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 ->
          Maybe [UpdateCostAllocationTagsStatusError]
-> Int -> UpdateCostAllocationTagsStatusResponse
UpdateCostAllocationTagsStatusResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Errors" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => 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
    UpdateCostAllocationTagsStatus
  where
  hashWithSalt :: Int -> UpdateCostAllocationTagsStatus -> Int
hashWithSalt
    Int
_salt
    UpdateCostAllocationTagsStatus' {NonEmpty CostAllocationTagStatusEntry
costAllocationTagsStatus :: NonEmpty CostAllocationTagStatusEntry
$sel:costAllocationTagsStatus:UpdateCostAllocationTagsStatus' :: UpdateCostAllocationTagsStatus
-> NonEmpty CostAllocationTagStatusEntry
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty CostAllocationTagStatusEntry
costAllocationTagsStatus

instance
  Prelude.NFData
    UpdateCostAllocationTagsStatus
  where
  rnf :: UpdateCostAllocationTagsStatus -> ()
rnf UpdateCostAllocationTagsStatus' {NonEmpty CostAllocationTagStatusEntry
costAllocationTagsStatus :: NonEmpty CostAllocationTagStatusEntry
$sel:costAllocationTagsStatus:UpdateCostAllocationTagsStatus' :: UpdateCostAllocationTagsStatus
-> NonEmpty CostAllocationTagStatusEntry
..} =
    forall a. NFData a => a -> ()
Prelude.rnf NonEmpty CostAllocationTagStatusEntry
costAllocationTagsStatus

instance
  Data.ToHeaders
    UpdateCostAllocationTagsStatus
  where
  toHeaders :: UpdateCostAllocationTagsStatus -> 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.UpdateCostAllocationTagsStatus" ::
                          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 UpdateCostAllocationTagsStatus where
  toJSON :: UpdateCostAllocationTagsStatus -> Value
toJSON UpdateCostAllocationTagsStatus' {NonEmpty CostAllocationTagStatusEntry
costAllocationTagsStatus :: NonEmpty CostAllocationTagStatusEntry
$sel:costAllocationTagsStatus:UpdateCostAllocationTagsStatus' :: UpdateCostAllocationTagsStatus
-> NonEmpty CostAllocationTagStatusEntry
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"CostAllocationTagsStatus"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty CostAllocationTagStatusEntry
costAllocationTagsStatus
              )
          ]
      )

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

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

-- | /See:/ 'newUpdateCostAllocationTagsStatusResponse' smart constructor.
data UpdateCostAllocationTagsStatusResponse = UpdateCostAllocationTagsStatusResponse'
  { -- | A list of @UpdateCostAllocationTagsStatusError@ objects with error
    -- details about each cost allocation tag that can\'t be updated. If
    -- there\'s no failure, an empty array returns.
    UpdateCostAllocationTagsStatusResponse
-> Maybe [UpdateCostAllocationTagsStatusError]
errors :: Prelude.Maybe [UpdateCostAllocationTagsStatusError],
    -- | The response's http status code.
    UpdateCostAllocationTagsStatusResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateCostAllocationTagsStatusResponse
-> UpdateCostAllocationTagsStatusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCostAllocationTagsStatusResponse
-> UpdateCostAllocationTagsStatusResponse -> Bool
$c/= :: UpdateCostAllocationTagsStatusResponse
-> UpdateCostAllocationTagsStatusResponse -> Bool
== :: UpdateCostAllocationTagsStatusResponse
-> UpdateCostAllocationTagsStatusResponse -> Bool
$c== :: UpdateCostAllocationTagsStatusResponse
-> UpdateCostAllocationTagsStatusResponse -> Bool
Prelude.Eq, ReadPrec [UpdateCostAllocationTagsStatusResponse]
ReadPrec UpdateCostAllocationTagsStatusResponse
Int -> ReadS UpdateCostAllocationTagsStatusResponse
ReadS [UpdateCostAllocationTagsStatusResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCostAllocationTagsStatusResponse]
$creadListPrec :: ReadPrec [UpdateCostAllocationTagsStatusResponse]
readPrec :: ReadPrec UpdateCostAllocationTagsStatusResponse
$creadPrec :: ReadPrec UpdateCostAllocationTagsStatusResponse
readList :: ReadS [UpdateCostAllocationTagsStatusResponse]
$creadList :: ReadS [UpdateCostAllocationTagsStatusResponse]
readsPrec :: Int -> ReadS UpdateCostAllocationTagsStatusResponse
$creadsPrec :: Int -> ReadS UpdateCostAllocationTagsStatusResponse
Prelude.Read, Int -> UpdateCostAllocationTagsStatusResponse -> ShowS
[UpdateCostAllocationTagsStatusResponse] -> ShowS
UpdateCostAllocationTagsStatusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCostAllocationTagsStatusResponse] -> ShowS
$cshowList :: [UpdateCostAllocationTagsStatusResponse] -> ShowS
show :: UpdateCostAllocationTagsStatusResponse -> String
$cshow :: UpdateCostAllocationTagsStatusResponse -> String
showsPrec :: Int -> UpdateCostAllocationTagsStatusResponse -> ShowS
$cshowsPrec :: Int -> UpdateCostAllocationTagsStatusResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateCostAllocationTagsStatusResponse x
-> UpdateCostAllocationTagsStatusResponse
forall x.
UpdateCostAllocationTagsStatusResponse
-> Rep UpdateCostAllocationTagsStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateCostAllocationTagsStatusResponse x
-> UpdateCostAllocationTagsStatusResponse
$cfrom :: forall x.
UpdateCostAllocationTagsStatusResponse
-> Rep UpdateCostAllocationTagsStatusResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCostAllocationTagsStatusResponse' 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:
--
-- 'errors', 'updateCostAllocationTagsStatusResponse_errors' - A list of @UpdateCostAllocationTagsStatusError@ objects with error
-- details about each cost allocation tag that can\'t be updated. If
-- there\'s no failure, an empty array returns.
--
-- 'httpStatus', 'updateCostAllocationTagsStatusResponse_httpStatus' - The response's http status code.
newUpdateCostAllocationTagsStatusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateCostAllocationTagsStatusResponse
newUpdateCostAllocationTagsStatusResponse :: Int -> UpdateCostAllocationTagsStatusResponse
newUpdateCostAllocationTagsStatusResponse
  Int
pHttpStatus_ =
    UpdateCostAllocationTagsStatusResponse'
      { $sel:errors:UpdateCostAllocationTagsStatusResponse' :: Maybe [UpdateCostAllocationTagsStatusError]
errors =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:UpdateCostAllocationTagsStatusResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | A list of @UpdateCostAllocationTagsStatusError@ objects with error
-- details about each cost allocation tag that can\'t be updated. If
-- there\'s no failure, an empty array returns.
updateCostAllocationTagsStatusResponse_errors :: Lens.Lens' UpdateCostAllocationTagsStatusResponse (Prelude.Maybe [UpdateCostAllocationTagsStatusError])
updateCostAllocationTagsStatusResponse_errors :: Lens'
  UpdateCostAllocationTagsStatusResponse
  (Maybe [UpdateCostAllocationTagsStatusError])
updateCostAllocationTagsStatusResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCostAllocationTagsStatusResponse' {Maybe [UpdateCostAllocationTagsStatusError]
errors :: Maybe [UpdateCostAllocationTagsStatusError]
$sel:errors:UpdateCostAllocationTagsStatusResponse' :: UpdateCostAllocationTagsStatusResponse
-> Maybe [UpdateCostAllocationTagsStatusError]
errors} -> Maybe [UpdateCostAllocationTagsStatusError]
errors) (\s :: UpdateCostAllocationTagsStatusResponse
s@UpdateCostAllocationTagsStatusResponse' {} Maybe [UpdateCostAllocationTagsStatusError]
a -> UpdateCostAllocationTagsStatusResponse
s {$sel:errors:UpdateCostAllocationTagsStatusResponse' :: Maybe [UpdateCostAllocationTagsStatusError]
errors = Maybe [UpdateCostAllocationTagsStatusError]
a} :: UpdateCostAllocationTagsStatusResponse) 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 response's http status code.
updateCostAllocationTagsStatusResponse_httpStatus :: Lens.Lens' UpdateCostAllocationTagsStatusResponse Prelude.Int
updateCostAllocationTagsStatusResponse_httpStatus :: Lens' UpdateCostAllocationTagsStatusResponse Int
updateCostAllocationTagsStatusResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCostAllocationTagsStatusResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateCostAllocationTagsStatusResponse' :: UpdateCostAllocationTagsStatusResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateCostAllocationTagsStatusResponse
s@UpdateCostAllocationTagsStatusResponse' {} Int
a -> UpdateCostAllocationTagsStatusResponse
s {$sel:httpStatus:UpdateCostAllocationTagsStatusResponse' :: Int
httpStatus = Int
a} :: UpdateCostAllocationTagsStatusResponse)

instance
  Prelude.NFData
    UpdateCostAllocationTagsStatusResponse
  where
  rnf :: UpdateCostAllocationTagsStatusResponse -> ()
rnf UpdateCostAllocationTagsStatusResponse' {Int
Maybe [UpdateCostAllocationTagsStatusError]
httpStatus :: Int
errors :: Maybe [UpdateCostAllocationTagsStatusError]
$sel:httpStatus:UpdateCostAllocationTagsStatusResponse' :: UpdateCostAllocationTagsStatusResponse -> Int
$sel:errors:UpdateCostAllocationTagsStatusResponse' :: UpdateCostAllocationTagsStatusResponse
-> Maybe [UpdateCostAllocationTagsStatusError]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [UpdateCostAllocationTagsStatusError]
errors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus