{-# 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.GlobalAccelerator.UpdateAcceleratorAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update the attributes for an accelerator.
module Amazonka.GlobalAccelerator.UpdateAcceleratorAttributes
  ( -- * Creating a Request
    UpdateAcceleratorAttributes (..),
    newUpdateAcceleratorAttributes,

    -- * Request Lenses
    updateAcceleratorAttributes_flowLogsEnabled,
    updateAcceleratorAttributes_flowLogsS3Bucket,
    updateAcceleratorAttributes_flowLogsS3Prefix,
    updateAcceleratorAttributes_acceleratorArn,

    -- * Destructuring the Response
    UpdateAcceleratorAttributesResponse (..),
    newUpdateAcceleratorAttributesResponse,

    -- * Response Lenses
    updateAcceleratorAttributesResponse_acceleratorAttributes,
    updateAcceleratorAttributesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateAcceleratorAttributes' smart constructor.
data UpdateAcceleratorAttributes = UpdateAcceleratorAttributes'
  { -- | Update whether flow logs are enabled. The default value is false. If the
    -- value is true, @FlowLogsS3Bucket@ and @FlowLogsS3Prefix@ must be
    -- specified.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/global-accelerator/latest/dg/monitoring-global-accelerator.flow-logs.html Flow Logs>
    -- in the /Global Accelerator Developer Guide/.
    UpdateAcceleratorAttributes -> Maybe Bool
flowLogsEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The name of the Amazon S3 bucket for the flow logs. Attribute is
    -- required if @FlowLogsEnabled@ is @true@. The bucket must exist and have
    -- a bucket policy that grants Global Accelerator permission to write to
    -- the bucket.
    UpdateAcceleratorAttributes -> Maybe Text
flowLogsS3Bucket :: Prelude.Maybe Prelude.Text,
    -- | Update the prefix for the location in the Amazon S3 bucket for the flow
    -- logs. Attribute is required if @FlowLogsEnabled@ is @true@.
    --
    -- If you specify slash (\/) for the S3 bucket prefix, the log file bucket
    -- folder structure will include a double slash (\/\/), like the following:
    --
    -- s3-bucket_name\/\/AWSLogs\/aws_account_id
    UpdateAcceleratorAttributes -> Maybe Text
flowLogsS3Prefix :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the accelerator that you want to
    -- update.
    UpdateAcceleratorAttributes -> Text
acceleratorArn :: Prelude.Text
  }
  deriving (UpdateAcceleratorAttributes -> UpdateAcceleratorAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAcceleratorAttributes -> UpdateAcceleratorAttributes -> Bool
$c/= :: UpdateAcceleratorAttributes -> UpdateAcceleratorAttributes -> Bool
== :: UpdateAcceleratorAttributes -> UpdateAcceleratorAttributes -> Bool
$c== :: UpdateAcceleratorAttributes -> UpdateAcceleratorAttributes -> Bool
Prelude.Eq, ReadPrec [UpdateAcceleratorAttributes]
ReadPrec UpdateAcceleratorAttributes
Int -> ReadS UpdateAcceleratorAttributes
ReadS [UpdateAcceleratorAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAcceleratorAttributes]
$creadListPrec :: ReadPrec [UpdateAcceleratorAttributes]
readPrec :: ReadPrec UpdateAcceleratorAttributes
$creadPrec :: ReadPrec UpdateAcceleratorAttributes
readList :: ReadS [UpdateAcceleratorAttributes]
$creadList :: ReadS [UpdateAcceleratorAttributes]
readsPrec :: Int -> ReadS UpdateAcceleratorAttributes
$creadsPrec :: Int -> ReadS UpdateAcceleratorAttributes
Prelude.Read, Int -> UpdateAcceleratorAttributes -> ShowS
[UpdateAcceleratorAttributes] -> ShowS
UpdateAcceleratorAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAcceleratorAttributes] -> ShowS
$cshowList :: [UpdateAcceleratorAttributes] -> ShowS
show :: UpdateAcceleratorAttributes -> String
$cshow :: UpdateAcceleratorAttributes -> String
showsPrec :: Int -> UpdateAcceleratorAttributes -> ShowS
$cshowsPrec :: Int -> UpdateAcceleratorAttributes -> ShowS
Prelude.Show, forall x.
Rep UpdateAcceleratorAttributes x -> UpdateAcceleratorAttributes
forall x.
UpdateAcceleratorAttributes -> Rep UpdateAcceleratorAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateAcceleratorAttributes x -> UpdateAcceleratorAttributes
$cfrom :: forall x.
UpdateAcceleratorAttributes -> Rep UpdateAcceleratorAttributes x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAcceleratorAttributes' 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:
--
-- 'flowLogsEnabled', 'updateAcceleratorAttributes_flowLogsEnabled' - Update whether flow logs are enabled. The default value is false. If the
-- value is true, @FlowLogsS3Bucket@ and @FlowLogsS3Prefix@ must be
-- specified.
--
-- For more information, see
-- <https://docs.aws.amazon.com/global-accelerator/latest/dg/monitoring-global-accelerator.flow-logs.html Flow Logs>
-- in the /Global Accelerator Developer Guide/.
--
-- 'flowLogsS3Bucket', 'updateAcceleratorAttributes_flowLogsS3Bucket' - The name of the Amazon S3 bucket for the flow logs. Attribute is
-- required if @FlowLogsEnabled@ is @true@. The bucket must exist and have
-- a bucket policy that grants Global Accelerator permission to write to
-- the bucket.
--
-- 'flowLogsS3Prefix', 'updateAcceleratorAttributes_flowLogsS3Prefix' - Update the prefix for the location in the Amazon S3 bucket for the flow
-- logs. Attribute is required if @FlowLogsEnabled@ is @true@.
--
-- If you specify slash (\/) for the S3 bucket prefix, the log file bucket
-- folder structure will include a double slash (\/\/), like the following:
--
-- s3-bucket_name\/\/AWSLogs\/aws_account_id
--
-- 'acceleratorArn', 'updateAcceleratorAttributes_acceleratorArn' - The Amazon Resource Name (ARN) of the accelerator that you want to
-- update.
newUpdateAcceleratorAttributes ::
  -- | 'acceleratorArn'
  Prelude.Text ->
  UpdateAcceleratorAttributes
newUpdateAcceleratorAttributes :: Text -> UpdateAcceleratorAttributes
newUpdateAcceleratorAttributes Text
pAcceleratorArn_ =
  UpdateAcceleratorAttributes'
    { $sel:flowLogsEnabled:UpdateAcceleratorAttributes' :: Maybe Bool
flowLogsEnabled =
        forall a. Maybe a
Prelude.Nothing,
      $sel:flowLogsS3Bucket:UpdateAcceleratorAttributes' :: Maybe Text
flowLogsS3Bucket = forall a. Maybe a
Prelude.Nothing,
      $sel:flowLogsS3Prefix:UpdateAcceleratorAttributes' :: Maybe Text
flowLogsS3Prefix = forall a. Maybe a
Prelude.Nothing,
      $sel:acceleratorArn:UpdateAcceleratorAttributes' :: Text
acceleratorArn = Text
pAcceleratorArn_
    }

-- | Update whether flow logs are enabled. The default value is false. If the
-- value is true, @FlowLogsS3Bucket@ and @FlowLogsS3Prefix@ must be
-- specified.
--
-- For more information, see
-- <https://docs.aws.amazon.com/global-accelerator/latest/dg/monitoring-global-accelerator.flow-logs.html Flow Logs>
-- in the /Global Accelerator Developer Guide/.
updateAcceleratorAttributes_flowLogsEnabled :: Lens.Lens' UpdateAcceleratorAttributes (Prelude.Maybe Prelude.Bool)
updateAcceleratorAttributes_flowLogsEnabled :: Lens' UpdateAcceleratorAttributes (Maybe Bool)
updateAcceleratorAttributes_flowLogsEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAcceleratorAttributes' {Maybe Bool
flowLogsEnabled :: Maybe Bool
$sel:flowLogsEnabled:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Maybe Bool
flowLogsEnabled} -> Maybe Bool
flowLogsEnabled) (\s :: UpdateAcceleratorAttributes
s@UpdateAcceleratorAttributes' {} Maybe Bool
a -> UpdateAcceleratorAttributes
s {$sel:flowLogsEnabled:UpdateAcceleratorAttributes' :: Maybe Bool
flowLogsEnabled = Maybe Bool
a} :: UpdateAcceleratorAttributes)

-- | The name of the Amazon S3 bucket for the flow logs. Attribute is
-- required if @FlowLogsEnabled@ is @true@. The bucket must exist and have
-- a bucket policy that grants Global Accelerator permission to write to
-- the bucket.
updateAcceleratorAttributes_flowLogsS3Bucket :: Lens.Lens' UpdateAcceleratorAttributes (Prelude.Maybe Prelude.Text)
updateAcceleratorAttributes_flowLogsS3Bucket :: Lens' UpdateAcceleratorAttributes (Maybe Text)
updateAcceleratorAttributes_flowLogsS3Bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAcceleratorAttributes' {Maybe Text
flowLogsS3Bucket :: Maybe Text
$sel:flowLogsS3Bucket:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Maybe Text
flowLogsS3Bucket} -> Maybe Text
flowLogsS3Bucket) (\s :: UpdateAcceleratorAttributes
s@UpdateAcceleratorAttributes' {} Maybe Text
a -> UpdateAcceleratorAttributes
s {$sel:flowLogsS3Bucket:UpdateAcceleratorAttributes' :: Maybe Text
flowLogsS3Bucket = Maybe Text
a} :: UpdateAcceleratorAttributes)

-- | Update the prefix for the location in the Amazon S3 bucket for the flow
-- logs. Attribute is required if @FlowLogsEnabled@ is @true@.
--
-- If you specify slash (\/) for the S3 bucket prefix, the log file bucket
-- folder structure will include a double slash (\/\/), like the following:
--
-- s3-bucket_name\/\/AWSLogs\/aws_account_id
updateAcceleratorAttributes_flowLogsS3Prefix :: Lens.Lens' UpdateAcceleratorAttributes (Prelude.Maybe Prelude.Text)
updateAcceleratorAttributes_flowLogsS3Prefix :: Lens' UpdateAcceleratorAttributes (Maybe Text)
updateAcceleratorAttributes_flowLogsS3Prefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAcceleratorAttributes' {Maybe Text
flowLogsS3Prefix :: Maybe Text
$sel:flowLogsS3Prefix:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Maybe Text
flowLogsS3Prefix} -> Maybe Text
flowLogsS3Prefix) (\s :: UpdateAcceleratorAttributes
s@UpdateAcceleratorAttributes' {} Maybe Text
a -> UpdateAcceleratorAttributes
s {$sel:flowLogsS3Prefix:UpdateAcceleratorAttributes' :: Maybe Text
flowLogsS3Prefix = Maybe Text
a} :: UpdateAcceleratorAttributes)

-- | The Amazon Resource Name (ARN) of the accelerator that you want to
-- update.
updateAcceleratorAttributes_acceleratorArn :: Lens.Lens' UpdateAcceleratorAttributes Prelude.Text
updateAcceleratorAttributes_acceleratorArn :: Lens' UpdateAcceleratorAttributes Text
updateAcceleratorAttributes_acceleratorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAcceleratorAttributes' {Text
acceleratorArn :: Text
$sel:acceleratorArn:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Text
acceleratorArn} -> Text
acceleratorArn) (\s :: UpdateAcceleratorAttributes
s@UpdateAcceleratorAttributes' {} Text
a -> UpdateAcceleratorAttributes
s {$sel:acceleratorArn:UpdateAcceleratorAttributes' :: Text
acceleratorArn = Text
a} :: UpdateAcceleratorAttributes)

instance Core.AWSRequest UpdateAcceleratorAttributes where
  type
    AWSResponse UpdateAcceleratorAttributes =
      UpdateAcceleratorAttributesResponse
  request :: (Service -> Service)
-> UpdateAcceleratorAttributes
-> Request UpdateAcceleratorAttributes
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 UpdateAcceleratorAttributes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateAcceleratorAttributes)))
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 AcceleratorAttributes
-> Int -> UpdateAcceleratorAttributesResponse
UpdateAcceleratorAttributesResponse'
            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
"AcceleratorAttributes")
            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 UpdateAcceleratorAttributes where
  hashWithSalt :: Int -> UpdateAcceleratorAttributes -> Int
hashWithSalt Int
_salt UpdateAcceleratorAttributes' {Maybe Bool
Maybe Text
Text
acceleratorArn :: Text
flowLogsS3Prefix :: Maybe Text
flowLogsS3Bucket :: Maybe Text
flowLogsEnabled :: Maybe Bool
$sel:acceleratorArn:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Text
$sel:flowLogsS3Prefix:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Maybe Text
$sel:flowLogsS3Bucket:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Maybe Text
$sel:flowLogsEnabled:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
flowLogsEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
flowLogsS3Bucket
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
flowLogsS3Prefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
acceleratorArn

instance Prelude.NFData UpdateAcceleratorAttributes where
  rnf :: UpdateAcceleratorAttributes -> ()
rnf UpdateAcceleratorAttributes' {Maybe Bool
Maybe Text
Text
acceleratorArn :: Text
flowLogsS3Prefix :: Maybe Text
flowLogsS3Bucket :: Maybe Text
flowLogsEnabled :: Maybe Bool
$sel:acceleratorArn:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Text
$sel:flowLogsS3Prefix:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Maybe Text
$sel:flowLogsS3Bucket:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Maybe Text
$sel:flowLogsEnabled:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
flowLogsEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
flowLogsS3Bucket
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
flowLogsS3Prefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
acceleratorArn

instance Data.ToHeaders UpdateAcceleratorAttributes where
  toHeaders :: UpdateAcceleratorAttributes -> 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
"GlobalAccelerator_V20180706.UpdateAcceleratorAttributes" ::
                          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 UpdateAcceleratorAttributes where
  toJSON :: UpdateAcceleratorAttributes -> Value
toJSON UpdateAcceleratorAttributes' {Maybe Bool
Maybe Text
Text
acceleratorArn :: Text
flowLogsS3Prefix :: Maybe Text
flowLogsS3Bucket :: Maybe Text
flowLogsEnabled :: Maybe Bool
$sel:acceleratorArn:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Text
$sel:flowLogsS3Prefix:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Maybe Text
$sel:flowLogsS3Bucket:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Maybe Text
$sel:flowLogsEnabled:UpdateAcceleratorAttributes' :: UpdateAcceleratorAttributes -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"FlowLogsEnabled" 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
flowLogsEnabled,
            (Key
"FlowLogsS3Bucket" 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
flowLogsS3Bucket,
            (Key
"FlowLogsS3Prefix" 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
flowLogsS3Prefix,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AcceleratorArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
acceleratorArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateAcceleratorAttributesResponse' 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:
--
-- 'acceleratorAttributes', 'updateAcceleratorAttributesResponse_acceleratorAttributes' - Updated attributes for the accelerator.
--
-- 'httpStatus', 'updateAcceleratorAttributesResponse_httpStatus' - The response's http status code.
newUpdateAcceleratorAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateAcceleratorAttributesResponse
newUpdateAcceleratorAttributesResponse :: Int -> UpdateAcceleratorAttributesResponse
newUpdateAcceleratorAttributesResponse Int
pHttpStatus_ =
  UpdateAcceleratorAttributesResponse'
    { $sel:acceleratorAttributes:UpdateAcceleratorAttributesResponse' :: Maybe AcceleratorAttributes
acceleratorAttributes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateAcceleratorAttributesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Updated attributes for the accelerator.
updateAcceleratorAttributesResponse_acceleratorAttributes :: Lens.Lens' UpdateAcceleratorAttributesResponse (Prelude.Maybe AcceleratorAttributes)
updateAcceleratorAttributesResponse_acceleratorAttributes :: Lens'
  UpdateAcceleratorAttributesResponse (Maybe AcceleratorAttributes)
updateAcceleratorAttributesResponse_acceleratorAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAcceleratorAttributesResponse' {Maybe AcceleratorAttributes
acceleratorAttributes :: Maybe AcceleratorAttributes
$sel:acceleratorAttributes:UpdateAcceleratorAttributesResponse' :: UpdateAcceleratorAttributesResponse -> Maybe AcceleratorAttributes
acceleratorAttributes} -> Maybe AcceleratorAttributes
acceleratorAttributes) (\s :: UpdateAcceleratorAttributesResponse
s@UpdateAcceleratorAttributesResponse' {} Maybe AcceleratorAttributes
a -> UpdateAcceleratorAttributesResponse
s {$sel:acceleratorAttributes:UpdateAcceleratorAttributesResponse' :: Maybe AcceleratorAttributes
acceleratorAttributes = Maybe AcceleratorAttributes
a} :: UpdateAcceleratorAttributesResponse)

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

instance
  Prelude.NFData
    UpdateAcceleratorAttributesResponse
  where
  rnf :: UpdateAcceleratorAttributesResponse -> ()
rnf UpdateAcceleratorAttributesResponse' {Int
Maybe AcceleratorAttributes
httpStatus :: Int
acceleratorAttributes :: Maybe AcceleratorAttributes
$sel:httpStatus:UpdateAcceleratorAttributesResponse' :: UpdateAcceleratorAttributesResponse -> Int
$sel:acceleratorAttributes:UpdateAcceleratorAttributesResponse' :: UpdateAcceleratorAttributesResponse -> Maybe AcceleratorAttributes
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AcceleratorAttributes
acceleratorAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus