{-# 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.MigrationHub.PutResourceAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides identifying details of the resource being migrated so that it
-- can be associated in the Application Discovery Service repository. This
-- association occurs asynchronously after @PutResourceAttributes@ returns.
--
-- -   Keep in mind that subsequent calls to PutResourceAttributes will
--     override previously stored attributes. For example, if it is first
--     called with a MAC address, but later, it is desired to /add/ an IP
--     address, it will then be required to call it with /both/ the IP and
--     MAC addresses to prevent overriding the MAC address.
--
-- -   Note the instructions regarding the special use case of the
--     <https://docs.aws.amazon.com/migrationhub/latest/ug/API_PutResourceAttributes.html#migrationhub-PutResourceAttributes-request-ResourceAttributeList ResourceAttributeList>
--     parameter when specifying any \"VM\" related value.
--
-- Because this is an asynchronous call, it will always return 200, whether
-- an association occurs or not. To confirm if an association was found
-- based on the provided details, call @ListDiscoveredResources@.
module Amazonka.MigrationHub.PutResourceAttributes
  ( -- * Creating a Request
    PutResourceAttributes (..),
    newPutResourceAttributes,

    -- * Request Lenses
    putResourceAttributes_dryRun,
    putResourceAttributes_progressUpdateStream,
    putResourceAttributes_migrationTaskName,
    putResourceAttributes_resourceAttributeList,

    -- * Destructuring the Response
    PutResourceAttributesResponse (..),
    newPutResourceAttributesResponse,

    -- * Response Lenses
    putResourceAttributesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPutResourceAttributes' smart constructor.
data PutResourceAttributes = PutResourceAttributes'
  { -- | Optional boolean flag to indicate whether any effect should take place.
    -- Used to test if the caller has permission to make the call.
    PutResourceAttributes -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The name of the ProgressUpdateStream.
    PutResourceAttributes -> Text
progressUpdateStream :: Prelude.Text,
    -- | Unique identifier that references the migration task. /Do not store
    -- personal data in this field./
    PutResourceAttributes -> Text
migrationTaskName :: Prelude.Text,
    -- | Information about the resource that is being migrated. This data will be
    -- used to map the task to a resource in the Application Discovery Service
    -- repository.
    --
    -- Takes the object array of @ResourceAttribute@ where the @Type@ field is
    -- reserved for the following values:
    -- @IPV4_ADDRESS | IPV6_ADDRESS | MAC_ADDRESS | FQDN | VM_MANAGER_ID | VM_MANAGED_OBJECT_REFERENCE | VM_NAME | VM_PATH | BIOS_ID | MOTHERBOARD_SERIAL_NUMBER@
    -- where the identifying value can be a string up to 256 characters.
    --
    -- -   If any \"VM\" related value is set for a @ResourceAttribute@ object,
    --     it is required that @VM_MANAGER_ID@, as a minimum, is always set. If
    --     @VM_MANAGER_ID@ is not set, then all \"VM\" fields will be discarded
    --     and \"VM\" fields will not be used for matching the migration task
    --     to a server in Application Discovery Service repository. See the
    --     <https://docs.aws.amazon.com/migrationhub/latest/ug/API_PutResourceAttributes.html#API_PutResourceAttributes_Examples Example>
    --     section below for a use case of specifying \"VM\" related values.
    --
    -- -   If a server you are trying to match has multiple IP or MAC
    --     addresses, you should provide as many as you know in separate
    --     type\/value pairs passed to the @ResourceAttributeList@ parameter to
    --     maximize the chances of matching.
    PutResourceAttributes -> NonEmpty ResourceAttribute
resourceAttributeList :: Prelude.NonEmpty ResourceAttribute
  }
  deriving (PutResourceAttributes -> PutResourceAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutResourceAttributes -> PutResourceAttributes -> Bool
$c/= :: PutResourceAttributes -> PutResourceAttributes -> Bool
== :: PutResourceAttributes -> PutResourceAttributes -> Bool
$c== :: PutResourceAttributes -> PutResourceAttributes -> Bool
Prelude.Eq, ReadPrec [PutResourceAttributes]
ReadPrec PutResourceAttributes
Int -> ReadS PutResourceAttributes
ReadS [PutResourceAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutResourceAttributes]
$creadListPrec :: ReadPrec [PutResourceAttributes]
readPrec :: ReadPrec PutResourceAttributes
$creadPrec :: ReadPrec PutResourceAttributes
readList :: ReadS [PutResourceAttributes]
$creadList :: ReadS [PutResourceAttributes]
readsPrec :: Int -> ReadS PutResourceAttributes
$creadsPrec :: Int -> ReadS PutResourceAttributes
Prelude.Read, Int -> PutResourceAttributes -> ShowS
[PutResourceAttributes] -> ShowS
PutResourceAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutResourceAttributes] -> ShowS
$cshowList :: [PutResourceAttributes] -> ShowS
show :: PutResourceAttributes -> String
$cshow :: PutResourceAttributes -> String
showsPrec :: Int -> PutResourceAttributes -> ShowS
$cshowsPrec :: Int -> PutResourceAttributes -> ShowS
Prelude.Show, forall x. Rep PutResourceAttributes x -> PutResourceAttributes
forall x. PutResourceAttributes -> Rep PutResourceAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutResourceAttributes x -> PutResourceAttributes
$cfrom :: forall x. PutResourceAttributes -> Rep PutResourceAttributes x
Prelude.Generic)

-- |
-- Create a value of 'PutResourceAttributes' 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:
--
-- 'dryRun', 'putResourceAttributes_dryRun' - Optional boolean flag to indicate whether any effect should take place.
-- Used to test if the caller has permission to make the call.
--
-- 'progressUpdateStream', 'putResourceAttributes_progressUpdateStream' - The name of the ProgressUpdateStream.
--
-- 'migrationTaskName', 'putResourceAttributes_migrationTaskName' - Unique identifier that references the migration task. /Do not store
-- personal data in this field./
--
-- 'resourceAttributeList', 'putResourceAttributes_resourceAttributeList' - Information about the resource that is being migrated. This data will be
-- used to map the task to a resource in the Application Discovery Service
-- repository.
--
-- Takes the object array of @ResourceAttribute@ where the @Type@ field is
-- reserved for the following values:
-- @IPV4_ADDRESS | IPV6_ADDRESS | MAC_ADDRESS | FQDN | VM_MANAGER_ID | VM_MANAGED_OBJECT_REFERENCE | VM_NAME | VM_PATH | BIOS_ID | MOTHERBOARD_SERIAL_NUMBER@
-- where the identifying value can be a string up to 256 characters.
--
-- -   If any \"VM\" related value is set for a @ResourceAttribute@ object,
--     it is required that @VM_MANAGER_ID@, as a minimum, is always set. If
--     @VM_MANAGER_ID@ is not set, then all \"VM\" fields will be discarded
--     and \"VM\" fields will not be used for matching the migration task
--     to a server in Application Discovery Service repository. See the
--     <https://docs.aws.amazon.com/migrationhub/latest/ug/API_PutResourceAttributes.html#API_PutResourceAttributes_Examples Example>
--     section below for a use case of specifying \"VM\" related values.
--
-- -   If a server you are trying to match has multiple IP or MAC
--     addresses, you should provide as many as you know in separate
--     type\/value pairs passed to the @ResourceAttributeList@ parameter to
--     maximize the chances of matching.
newPutResourceAttributes ::
  -- | 'progressUpdateStream'
  Prelude.Text ->
  -- | 'migrationTaskName'
  Prelude.Text ->
  -- | 'resourceAttributeList'
  Prelude.NonEmpty ResourceAttribute ->
  PutResourceAttributes
newPutResourceAttributes :: Text -> Text -> NonEmpty ResourceAttribute -> PutResourceAttributes
newPutResourceAttributes
  Text
pProgressUpdateStream_
  Text
pMigrationTaskName_
  NonEmpty ResourceAttribute
pResourceAttributeList_ =
    PutResourceAttributes'
      { $sel:dryRun:PutResourceAttributes' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:progressUpdateStream:PutResourceAttributes' :: Text
progressUpdateStream = Text
pProgressUpdateStream_,
        $sel:migrationTaskName:PutResourceAttributes' :: Text
migrationTaskName = Text
pMigrationTaskName_,
        $sel:resourceAttributeList:PutResourceAttributes' :: NonEmpty ResourceAttribute
resourceAttributeList =
          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 ResourceAttribute
pResourceAttributeList_
      }

-- | Optional boolean flag to indicate whether any effect should take place.
-- Used to test if the caller has permission to make the call.
putResourceAttributes_dryRun :: Lens.Lens' PutResourceAttributes (Prelude.Maybe Prelude.Bool)
putResourceAttributes_dryRun :: Lens' PutResourceAttributes (Maybe Bool)
putResourceAttributes_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourceAttributes' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:PutResourceAttributes' :: PutResourceAttributes -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: PutResourceAttributes
s@PutResourceAttributes' {} Maybe Bool
a -> PutResourceAttributes
s {$sel:dryRun:PutResourceAttributes' :: Maybe Bool
dryRun = Maybe Bool
a} :: PutResourceAttributes)

-- | The name of the ProgressUpdateStream.
putResourceAttributes_progressUpdateStream :: Lens.Lens' PutResourceAttributes Prelude.Text
putResourceAttributes_progressUpdateStream :: Lens' PutResourceAttributes Text
putResourceAttributes_progressUpdateStream = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourceAttributes' {Text
progressUpdateStream :: Text
$sel:progressUpdateStream:PutResourceAttributes' :: PutResourceAttributes -> Text
progressUpdateStream} -> Text
progressUpdateStream) (\s :: PutResourceAttributes
s@PutResourceAttributes' {} Text
a -> PutResourceAttributes
s {$sel:progressUpdateStream:PutResourceAttributes' :: Text
progressUpdateStream = Text
a} :: PutResourceAttributes)

-- | Unique identifier that references the migration task. /Do not store
-- personal data in this field./
putResourceAttributes_migrationTaskName :: Lens.Lens' PutResourceAttributes Prelude.Text
putResourceAttributes_migrationTaskName :: Lens' PutResourceAttributes Text
putResourceAttributes_migrationTaskName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourceAttributes' {Text
migrationTaskName :: Text
$sel:migrationTaskName:PutResourceAttributes' :: PutResourceAttributes -> Text
migrationTaskName} -> Text
migrationTaskName) (\s :: PutResourceAttributes
s@PutResourceAttributes' {} Text
a -> PutResourceAttributes
s {$sel:migrationTaskName:PutResourceAttributes' :: Text
migrationTaskName = Text
a} :: PutResourceAttributes)

-- | Information about the resource that is being migrated. This data will be
-- used to map the task to a resource in the Application Discovery Service
-- repository.
--
-- Takes the object array of @ResourceAttribute@ where the @Type@ field is
-- reserved for the following values:
-- @IPV4_ADDRESS | IPV6_ADDRESS | MAC_ADDRESS | FQDN | VM_MANAGER_ID | VM_MANAGED_OBJECT_REFERENCE | VM_NAME | VM_PATH | BIOS_ID | MOTHERBOARD_SERIAL_NUMBER@
-- where the identifying value can be a string up to 256 characters.
--
-- -   If any \"VM\" related value is set for a @ResourceAttribute@ object,
--     it is required that @VM_MANAGER_ID@, as a minimum, is always set. If
--     @VM_MANAGER_ID@ is not set, then all \"VM\" fields will be discarded
--     and \"VM\" fields will not be used for matching the migration task
--     to a server in Application Discovery Service repository. See the
--     <https://docs.aws.amazon.com/migrationhub/latest/ug/API_PutResourceAttributes.html#API_PutResourceAttributes_Examples Example>
--     section below for a use case of specifying \"VM\" related values.
--
-- -   If a server you are trying to match has multiple IP or MAC
--     addresses, you should provide as many as you know in separate
--     type\/value pairs passed to the @ResourceAttributeList@ parameter to
--     maximize the chances of matching.
putResourceAttributes_resourceAttributeList :: Lens.Lens' PutResourceAttributes (Prelude.NonEmpty ResourceAttribute)
putResourceAttributes_resourceAttributeList :: Lens' PutResourceAttributes (NonEmpty ResourceAttribute)
putResourceAttributes_resourceAttributeList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourceAttributes' {NonEmpty ResourceAttribute
resourceAttributeList :: NonEmpty ResourceAttribute
$sel:resourceAttributeList:PutResourceAttributes' :: PutResourceAttributes -> NonEmpty ResourceAttribute
resourceAttributeList} -> NonEmpty ResourceAttribute
resourceAttributeList) (\s :: PutResourceAttributes
s@PutResourceAttributes' {} NonEmpty ResourceAttribute
a -> PutResourceAttributes
s {$sel:resourceAttributeList:PutResourceAttributes' :: NonEmpty ResourceAttribute
resourceAttributeList = NonEmpty ResourceAttribute
a} :: PutResourceAttributes) 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 PutResourceAttributes where
  type
    AWSResponse PutResourceAttributes =
      PutResourceAttributesResponse
  request :: (Service -> Service)
-> PutResourceAttributes -> Request PutResourceAttributes
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 PutResourceAttributes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutResourceAttributes)))
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 -> PutResourceAttributesResponse
PutResourceAttributesResponse'
            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 PutResourceAttributes where
  hashWithSalt :: Int -> PutResourceAttributes -> Int
hashWithSalt Int
_salt PutResourceAttributes' {Maybe Bool
NonEmpty ResourceAttribute
Text
resourceAttributeList :: NonEmpty ResourceAttribute
migrationTaskName :: Text
progressUpdateStream :: Text
dryRun :: Maybe Bool
$sel:resourceAttributeList:PutResourceAttributes' :: PutResourceAttributes -> NonEmpty ResourceAttribute
$sel:migrationTaskName:PutResourceAttributes' :: PutResourceAttributes -> Text
$sel:progressUpdateStream:PutResourceAttributes' :: PutResourceAttributes -> Text
$sel:dryRun:PutResourceAttributes' :: PutResourceAttributes -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
progressUpdateStream
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
migrationTaskName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty ResourceAttribute
resourceAttributeList

instance Prelude.NFData PutResourceAttributes where
  rnf :: PutResourceAttributes -> ()
rnf PutResourceAttributes' {Maybe Bool
NonEmpty ResourceAttribute
Text
resourceAttributeList :: NonEmpty ResourceAttribute
migrationTaskName :: Text
progressUpdateStream :: Text
dryRun :: Maybe Bool
$sel:resourceAttributeList:PutResourceAttributes' :: PutResourceAttributes -> NonEmpty ResourceAttribute
$sel:migrationTaskName:PutResourceAttributes' :: PutResourceAttributes -> Text
$sel:progressUpdateStream:PutResourceAttributes' :: PutResourceAttributes -> Text
$sel:dryRun:PutResourceAttributes' :: PutResourceAttributes -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
progressUpdateStream
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
migrationTaskName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty ResourceAttribute
resourceAttributeList

instance Data.ToHeaders PutResourceAttributes where
  toHeaders :: PutResourceAttributes -> 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
"AWSMigrationHub.PutResourceAttributes" ::
                          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 PutResourceAttributes where
  toJSON :: PutResourceAttributes -> Value
toJSON PutResourceAttributes' {Maybe Bool
NonEmpty ResourceAttribute
Text
resourceAttributeList :: NonEmpty ResourceAttribute
migrationTaskName :: Text
progressUpdateStream :: Text
dryRun :: Maybe Bool
$sel:resourceAttributeList:PutResourceAttributes' :: PutResourceAttributes -> NonEmpty ResourceAttribute
$sel:migrationTaskName:PutResourceAttributes' :: PutResourceAttributes -> Text
$sel:progressUpdateStream:PutResourceAttributes' :: PutResourceAttributes -> Text
$sel:dryRun:PutResourceAttributes' :: PutResourceAttributes -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DryRun" 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 Bool
dryRun,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ProgressUpdateStream"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
progressUpdateStream
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"MigrationTaskName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
migrationTaskName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ResourceAttributeList"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty ResourceAttribute
resourceAttributeList
              )
          ]
      )

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

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

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

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

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

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