{-# 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.Route53.ChangeTagsForResource
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds, edits, or deletes tags for a health check or a hosted zone.
--
-- For information about using tags for cost allocation, see
-- <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/cost-alloc-tags.html Using Cost Allocation Tags>
-- in the /Billing and Cost Management User Guide/.
module Amazonka.Route53.ChangeTagsForResource
  ( -- * Creating a Request
    ChangeTagsForResource (..),
    newChangeTagsForResource,

    -- * Request Lenses
    changeTagsForResource_addTags,
    changeTagsForResource_removeTagKeys,
    changeTagsForResource_resourceType,
    changeTagsForResource_resourceId,

    -- * Destructuring the Response
    ChangeTagsForResourceResponse (..),
    newChangeTagsForResourceResponse,

    -- * Response Lenses
    changeTagsForResourceResponse_httpStatus,
  )
where

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
import Amazonka.Route53.Types

-- | A complex type that contains information about the tags that you want to
-- add, edit, or delete.
--
-- /See:/ 'newChangeTagsForResource' smart constructor.
data ChangeTagsForResource = ChangeTagsForResource'
  { -- | A complex type that contains a list of the tags that you want to add to
    -- the specified health check or hosted zone and\/or the tags that you want
    -- to edit @Value@ for.
    --
    -- You can add a maximum of 10 tags to a health check or a hosted zone.
    ChangeTagsForResource -> Maybe (NonEmpty Tag)
addTags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | A complex type that contains a list of the tags that you want to delete
    -- from the specified health check or hosted zone. You can specify up to 10
    -- keys.
    ChangeTagsForResource -> Maybe (NonEmpty Text)
removeTagKeys :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The type of the resource.
    --
    -- -   The resource type for health checks is @healthcheck@.
    --
    -- -   The resource type for hosted zones is @hostedzone@.
    ChangeTagsForResource -> TagResourceType
resourceType :: TagResourceType,
    -- | The ID of the resource for which you want to add, change, or delete
    -- tags.
    ChangeTagsForResource -> Text
resourceId :: Prelude.Text
  }
  deriving (ChangeTagsForResource -> ChangeTagsForResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeTagsForResource -> ChangeTagsForResource -> Bool
$c/= :: ChangeTagsForResource -> ChangeTagsForResource -> Bool
== :: ChangeTagsForResource -> ChangeTagsForResource -> Bool
$c== :: ChangeTagsForResource -> ChangeTagsForResource -> Bool
Prelude.Eq, ReadPrec [ChangeTagsForResource]
ReadPrec ChangeTagsForResource
Int -> ReadS ChangeTagsForResource
ReadS [ChangeTagsForResource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChangeTagsForResource]
$creadListPrec :: ReadPrec [ChangeTagsForResource]
readPrec :: ReadPrec ChangeTagsForResource
$creadPrec :: ReadPrec ChangeTagsForResource
readList :: ReadS [ChangeTagsForResource]
$creadList :: ReadS [ChangeTagsForResource]
readsPrec :: Int -> ReadS ChangeTagsForResource
$creadsPrec :: Int -> ReadS ChangeTagsForResource
Prelude.Read, Int -> ChangeTagsForResource -> ShowS
[ChangeTagsForResource] -> ShowS
ChangeTagsForResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangeTagsForResource] -> ShowS
$cshowList :: [ChangeTagsForResource] -> ShowS
show :: ChangeTagsForResource -> String
$cshow :: ChangeTagsForResource -> String
showsPrec :: Int -> ChangeTagsForResource -> ShowS
$cshowsPrec :: Int -> ChangeTagsForResource -> ShowS
Prelude.Show, forall x. Rep ChangeTagsForResource x -> ChangeTagsForResource
forall x. ChangeTagsForResource -> Rep ChangeTagsForResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChangeTagsForResource x -> ChangeTagsForResource
$cfrom :: forall x. ChangeTagsForResource -> Rep ChangeTagsForResource x
Prelude.Generic)

-- |
-- Create a value of 'ChangeTagsForResource' 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:
--
-- 'addTags', 'changeTagsForResource_addTags' - A complex type that contains a list of the tags that you want to add to
-- the specified health check or hosted zone and\/or the tags that you want
-- to edit @Value@ for.
--
-- You can add a maximum of 10 tags to a health check or a hosted zone.
--
-- 'removeTagKeys', 'changeTagsForResource_removeTagKeys' - A complex type that contains a list of the tags that you want to delete
-- from the specified health check or hosted zone. You can specify up to 10
-- keys.
--
-- 'resourceType', 'changeTagsForResource_resourceType' - The type of the resource.
--
-- -   The resource type for health checks is @healthcheck@.
--
-- -   The resource type for hosted zones is @hostedzone@.
--
-- 'resourceId', 'changeTagsForResource_resourceId' - The ID of the resource for which you want to add, change, or delete
-- tags.
newChangeTagsForResource ::
  -- | 'resourceType'
  TagResourceType ->
  -- | 'resourceId'
  Prelude.Text ->
  ChangeTagsForResource
newChangeTagsForResource :: TagResourceType -> Text -> ChangeTagsForResource
newChangeTagsForResource TagResourceType
pResourceType_ Text
pResourceId_ =
  ChangeTagsForResource'
    { $sel:addTags:ChangeTagsForResource' :: Maybe (NonEmpty Tag)
addTags = forall a. Maybe a
Prelude.Nothing,
      $sel:removeTagKeys:ChangeTagsForResource' :: Maybe (NonEmpty Text)
removeTagKeys = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:ChangeTagsForResource' :: TagResourceType
resourceType = TagResourceType
pResourceType_,
      $sel:resourceId:ChangeTagsForResource' :: Text
resourceId = Text
pResourceId_
    }

-- | A complex type that contains a list of the tags that you want to add to
-- the specified health check or hosted zone and\/or the tags that you want
-- to edit @Value@ for.
--
-- You can add a maximum of 10 tags to a health check or a hosted zone.
changeTagsForResource_addTags :: Lens.Lens' ChangeTagsForResource (Prelude.Maybe (Prelude.NonEmpty Tag))
changeTagsForResource_addTags :: Lens' ChangeTagsForResource (Maybe (NonEmpty Tag))
changeTagsForResource_addTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChangeTagsForResource' {Maybe (NonEmpty Tag)
addTags :: Maybe (NonEmpty Tag)
$sel:addTags:ChangeTagsForResource' :: ChangeTagsForResource -> Maybe (NonEmpty Tag)
addTags} -> Maybe (NonEmpty Tag)
addTags) (\s :: ChangeTagsForResource
s@ChangeTagsForResource' {} Maybe (NonEmpty Tag)
a -> ChangeTagsForResource
s {$sel:addTags:ChangeTagsForResource' :: Maybe (NonEmpty Tag)
addTags = Maybe (NonEmpty Tag)
a} :: ChangeTagsForResource) 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

-- | A complex type that contains a list of the tags that you want to delete
-- from the specified health check or hosted zone. You can specify up to 10
-- keys.
changeTagsForResource_removeTagKeys :: Lens.Lens' ChangeTagsForResource (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
changeTagsForResource_removeTagKeys :: Lens' ChangeTagsForResource (Maybe (NonEmpty Text))
changeTagsForResource_removeTagKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChangeTagsForResource' {Maybe (NonEmpty Text)
removeTagKeys :: Maybe (NonEmpty Text)
$sel:removeTagKeys:ChangeTagsForResource' :: ChangeTagsForResource -> Maybe (NonEmpty Text)
removeTagKeys} -> Maybe (NonEmpty Text)
removeTagKeys) (\s :: ChangeTagsForResource
s@ChangeTagsForResource' {} Maybe (NonEmpty Text)
a -> ChangeTagsForResource
s {$sel:removeTagKeys:ChangeTagsForResource' :: Maybe (NonEmpty Text)
removeTagKeys = Maybe (NonEmpty Text)
a} :: ChangeTagsForResource) 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 type of the resource.
--
-- -   The resource type for health checks is @healthcheck@.
--
-- -   The resource type for hosted zones is @hostedzone@.
changeTagsForResource_resourceType :: Lens.Lens' ChangeTagsForResource TagResourceType
changeTagsForResource_resourceType :: Lens' ChangeTagsForResource TagResourceType
changeTagsForResource_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChangeTagsForResource' {TagResourceType
resourceType :: TagResourceType
$sel:resourceType:ChangeTagsForResource' :: ChangeTagsForResource -> TagResourceType
resourceType} -> TagResourceType
resourceType) (\s :: ChangeTagsForResource
s@ChangeTagsForResource' {} TagResourceType
a -> ChangeTagsForResource
s {$sel:resourceType:ChangeTagsForResource' :: TagResourceType
resourceType = TagResourceType
a} :: ChangeTagsForResource)

-- | The ID of the resource for which you want to add, change, or delete
-- tags.
changeTagsForResource_resourceId :: Lens.Lens' ChangeTagsForResource Prelude.Text
changeTagsForResource_resourceId :: Lens' ChangeTagsForResource Text
changeTagsForResource_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChangeTagsForResource' {Text
resourceId :: Text
$sel:resourceId:ChangeTagsForResource' :: ChangeTagsForResource -> Text
resourceId} -> Text
resourceId) (\s :: ChangeTagsForResource
s@ChangeTagsForResource' {} Text
a -> ChangeTagsForResource
s {$sel:resourceId:ChangeTagsForResource' :: Text
resourceId = Text
a} :: ChangeTagsForResource)

instance Core.AWSRequest ChangeTagsForResource where
  type
    AWSResponse ChangeTagsForResource =
      ChangeTagsForResourceResponse
  request :: (Service -> Service)
-> ChangeTagsForResource -> Request ChangeTagsForResource
request Service -> Service
overrides =
    forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
Request.postXML (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ChangeTagsForResource
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ChangeTagsForResource)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> ChangeTagsForResourceResponse
ChangeTagsForResourceResponse'
            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 ChangeTagsForResource where
  hashWithSalt :: Int -> ChangeTagsForResource -> Int
hashWithSalt Int
_salt ChangeTagsForResource' {Maybe (NonEmpty Text)
Maybe (NonEmpty Tag)
Text
TagResourceType
resourceId :: Text
resourceType :: TagResourceType
removeTagKeys :: Maybe (NonEmpty Text)
addTags :: Maybe (NonEmpty Tag)
$sel:resourceId:ChangeTagsForResource' :: ChangeTagsForResource -> Text
$sel:resourceType:ChangeTagsForResource' :: ChangeTagsForResource -> TagResourceType
$sel:removeTagKeys:ChangeTagsForResource' :: ChangeTagsForResource -> Maybe (NonEmpty Text)
$sel:addTags:ChangeTagsForResource' :: ChangeTagsForResource -> Maybe (NonEmpty Tag)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
addTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
removeTagKeys
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TagResourceType
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId

instance Prelude.NFData ChangeTagsForResource where
  rnf :: ChangeTagsForResource -> ()
rnf ChangeTagsForResource' {Maybe (NonEmpty Text)
Maybe (NonEmpty Tag)
Text
TagResourceType
resourceId :: Text
resourceType :: TagResourceType
removeTagKeys :: Maybe (NonEmpty Text)
addTags :: Maybe (NonEmpty Tag)
$sel:resourceId:ChangeTagsForResource' :: ChangeTagsForResource -> Text
$sel:resourceType:ChangeTagsForResource' :: ChangeTagsForResource -> TagResourceType
$sel:removeTagKeys:ChangeTagsForResource' :: ChangeTagsForResource -> Maybe (NonEmpty Text)
$sel:addTags:ChangeTagsForResource' :: ChangeTagsForResource -> Maybe (NonEmpty Tag)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
addTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
removeTagKeys
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TagResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId

instance Data.ToElement ChangeTagsForResource where
  toElement :: ChangeTagsForResource -> Element
toElement =
    forall a. ToXML a => Name -> a -> Element
Data.mkElement
      Name
"{https://route53.amazonaws.com/doc/2013-04-01/}ChangeTagsForResourceRequest"

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

instance Data.ToPath ChangeTagsForResource where
  toPath :: ChangeTagsForResource -> ByteString
toPath ChangeTagsForResource' {Maybe (NonEmpty Text)
Maybe (NonEmpty Tag)
Text
TagResourceType
resourceId :: Text
resourceType :: TagResourceType
removeTagKeys :: Maybe (NonEmpty Text)
addTags :: Maybe (NonEmpty Tag)
$sel:resourceId:ChangeTagsForResource' :: ChangeTagsForResource -> Text
$sel:resourceType:ChangeTagsForResource' :: ChangeTagsForResource -> TagResourceType
$sel:removeTagKeys:ChangeTagsForResource' :: ChangeTagsForResource -> Maybe (NonEmpty Text)
$sel:addTags:ChangeTagsForResource' :: ChangeTagsForResource -> Maybe (NonEmpty Tag)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2013-04-01/tags/",
        forall a. ToByteString a => a -> ByteString
Data.toBS TagResourceType
resourceType,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
resourceId
      ]

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

instance Data.ToXML ChangeTagsForResource where
  toXML :: ChangeTagsForResource -> XML
toXML ChangeTagsForResource' {Maybe (NonEmpty Text)
Maybe (NonEmpty Tag)
Text
TagResourceType
resourceId :: Text
resourceType :: TagResourceType
removeTagKeys :: Maybe (NonEmpty Text)
addTags :: Maybe (NonEmpty Tag)
$sel:resourceId:ChangeTagsForResource' :: ChangeTagsForResource -> Text
$sel:resourceType:ChangeTagsForResource' :: ChangeTagsForResource -> TagResourceType
$sel:removeTagKeys:ChangeTagsForResource' :: ChangeTagsForResource -> Maybe (NonEmpty Text)
$sel:addTags:ChangeTagsForResource' :: ChangeTagsForResource -> Maybe (NonEmpty Tag)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"AddTags"
          forall a. ToXML a => Name -> a -> XML
Data.@= forall a. ToXML a => a -> XML
Data.toXML
            (forall a. (IsList a, ToXML (Item a)) => Name -> a -> XML
Data.toXMLList Name
"Tag" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Tag)
addTags),
        Name
"RemoveTagKeys"
          forall a. ToXML a => Name -> a -> XML
Data.@= forall a. ToXML a => a -> XML
Data.toXML
            (forall a. (IsList a, ToXML (Item a)) => Name -> a -> XML
Data.toXMLList Name
"Key" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
removeTagKeys)
      ]

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

-- |
-- Create a value of 'ChangeTagsForResourceResponse' 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', 'changeTagsForResourceResponse_httpStatus' - The response's http status code.
newChangeTagsForResourceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ChangeTagsForResourceResponse
newChangeTagsForResourceResponse :: Int -> ChangeTagsForResourceResponse
newChangeTagsForResourceResponse Int
pHttpStatus_ =
  ChangeTagsForResourceResponse'
    { $sel:httpStatus:ChangeTagsForResourceResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

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