{-# 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.UpdateCustomRoutingAcceleratorAttributes
-- 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 a custom routing accelerator.
module Amazonka.GlobalAccelerator.UpdateCustomRoutingAcceleratorAttributes
  ( -- * Creating a Request
    UpdateCustomRoutingAcceleratorAttributes (..),
    newUpdateCustomRoutingAcceleratorAttributes,

    -- * Request Lenses
    updateCustomRoutingAcceleratorAttributes_flowLogsEnabled,
    updateCustomRoutingAcceleratorAttributes_flowLogsS3Bucket,
    updateCustomRoutingAcceleratorAttributes_flowLogsS3Prefix,
    updateCustomRoutingAcceleratorAttributes_acceleratorArn,

    -- * Destructuring the Response
    UpdateCustomRoutingAcceleratorAttributesResponse (..),
    newUpdateCustomRoutingAcceleratorAttributesResponse,

    -- * Response Lenses
    updateCustomRoutingAcceleratorAttributesResponse_acceleratorAttributes,
    updateCustomRoutingAcceleratorAttributesResponse_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:/ 'newUpdateCustomRoutingAcceleratorAttributes' smart constructor.
data UpdateCustomRoutingAcceleratorAttributes = UpdateCustomRoutingAcceleratorAttributes'
  { -- | 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/.
    UpdateCustomRoutingAcceleratorAttributes -> 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.
    UpdateCustomRoutingAcceleratorAttributes -> 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 don’t specify a prefix, the flow logs are stored in the root of
    -- the bucket. If you specify slash (\/) for the S3 bucket prefix, the log
    -- file bucket folder structure will include a double slash (\/\/), like
    -- the following:
    --
    -- DOC-EXAMPLE-BUCKET\/\/AWSLogs\/aws_account_id
    UpdateCustomRoutingAcceleratorAttributes -> Maybe Text
flowLogsS3Prefix :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the custom routing accelerator to
    -- update attributes for.
    UpdateCustomRoutingAcceleratorAttributes -> Text
acceleratorArn :: Prelude.Text
  }
  deriving (UpdateCustomRoutingAcceleratorAttributes
-> UpdateCustomRoutingAcceleratorAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCustomRoutingAcceleratorAttributes
-> UpdateCustomRoutingAcceleratorAttributes -> Bool
$c/= :: UpdateCustomRoutingAcceleratorAttributes
-> UpdateCustomRoutingAcceleratorAttributes -> Bool
== :: UpdateCustomRoutingAcceleratorAttributes
-> UpdateCustomRoutingAcceleratorAttributes -> Bool
$c== :: UpdateCustomRoutingAcceleratorAttributes
-> UpdateCustomRoutingAcceleratorAttributes -> Bool
Prelude.Eq, ReadPrec [UpdateCustomRoutingAcceleratorAttributes]
ReadPrec UpdateCustomRoutingAcceleratorAttributes
Int -> ReadS UpdateCustomRoutingAcceleratorAttributes
ReadS [UpdateCustomRoutingAcceleratorAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCustomRoutingAcceleratorAttributes]
$creadListPrec :: ReadPrec [UpdateCustomRoutingAcceleratorAttributes]
readPrec :: ReadPrec UpdateCustomRoutingAcceleratorAttributes
$creadPrec :: ReadPrec UpdateCustomRoutingAcceleratorAttributes
readList :: ReadS [UpdateCustomRoutingAcceleratorAttributes]
$creadList :: ReadS [UpdateCustomRoutingAcceleratorAttributes]
readsPrec :: Int -> ReadS UpdateCustomRoutingAcceleratorAttributes
$creadsPrec :: Int -> ReadS UpdateCustomRoutingAcceleratorAttributes
Prelude.Read, Int -> UpdateCustomRoutingAcceleratorAttributes -> ShowS
[UpdateCustomRoutingAcceleratorAttributes] -> ShowS
UpdateCustomRoutingAcceleratorAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCustomRoutingAcceleratorAttributes] -> ShowS
$cshowList :: [UpdateCustomRoutingAcceleratorAttributes] -> ShowS
show :: UpdateCustomRoutingAcceleratorAttributes -> String
$cshow :: UpdateCustomRoutingAcceleratorAttributes -> String
showsPrec :: Int -> UpdateCustomRoutingAcceleratorAttributes -> ShowS
$cshowsPrec :: Int -> UpdateCustomRoutingAcceleratorAttributes -> ShowS
Prelude.Show, forall x.
Rep UpdateCustomRoutingAcceleratorAttributes x
-> UpdateCustomRoutingAcceleratorAttributes
forall x.
UpdateCustomRoutingAcceleratorAttributes
-> Rep UpdateCustomRoutingAcceleratorAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateCustomRoutingAcceleratorAttributes x
-> UpdateCustomRoutingAcceleratorAttributes
$cfrom :: forall x.
UpdateCustomRoutingAcceleratorAttributes
-> Rep UpdateCustomRoutingAcceleratorAttributes x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCustomRoutingAcceleratorAttributes' 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', 'updateCustomRoutingAcceleratorAttributes_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', 'updateCustomRoutingAcceleratorAttributes_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', 'updateCustomRoutingAcceleratorAttributes_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 don’t specify a prefix, the flow logs are stored in the root of
-- the bucket. If you specify slash (\/) for the S3 bucket prefix, the log
-- file bucket folder structure will include a double slash (\/\/), like
-- the following:
--
-- DOC-EXAMPLE-BUCKET\/\/AWSLogs\/aws_account_id
--
-- 'acceleratorArn', 'updateCustomRoutingAcceleratorAttributes_acceleratorArn' - The Amazon Resource Name (ARN) of the custom routing accelerator to
-- update attributes for.
newUpdateCustomRoutingAcceleratorAttributes ::
  -- | 'acceleratorArn'
  Prelude.Text ->
  UpdateCustomRoutingAcceleratorAttributes
newUpdateCustomRoutingAcceleratorAttributes :: Text -> UpdateCustomRoutingAcceleratorAttributes
newUpdateCustomRoutingAcceleratorAttributes
  Text
pAcceleratorArn_ =
    UpdateCustomRoutingAcceleratorAttributes'
      { $sel:flowLogsEnabled:UpdateCustomRoutingAcceleratorAttributes' :: Maybe Bool
flowLogsEnabled =
          forall a. Maybe a
Prelude.Nothing,
        $sel:flowLogsS3Bucket:UpdateCustomRoutingAcceleratorAttributes' :: Maybe Text
flowLogsS3Bucket =
          forall a. Maybe a
Prelude.Nothing,
        $sel:flowLogsS3Prefix:UpdateCustomRoutingAcceleratorAttributes' :: Maybe Text
flowLogsS3Prefix =
          forall a. Maybe a
Prelude.Nothing,
        $sel:acceleratorArn:UpdateCustomRoutingAcceleratorAttributes' :: 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/.
updateCustomRoutingAcceleratorAttributes_flowLogsEnabled :: Lens.Lens' UpdateCustomRoutingAcceleratorAttributes (Prelude.Maybe Prelude.Bool)
updateCustomRoutingAcceleratorAttributes_flowLogsEnabled :: Lens' UpdateCustomRoutingAcceleratorAttributes (Maybe Bool)
updateCustomRoutingAcceleratorAttributes_flowLogsEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCustomRoutingAcceleratorAttributes' {Maybe Bool
flowLogsEnabled :: Maybe Bool
$sel:flowLogsEnabled:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> Maybe Bool
flowLogsEnabled} -> Maybe Bool
flowLogsEnabled) (\s :: UpdateCustomRoutingAcceleratorAttributes
s@UpdateCustomRoutingAcceleratorAttributes' {} Maybe Bool
a -> UpdateCustomRoutingAcceleratorAttributes
s {$sel:flowLogsEnabled:UpdateCustomRoutingAcceleratorAttributes' :: Maybe Bool
flowLogsEnabled = Maybe Bool
a} :: UpdateCustomRoutingAcceleratorAttributes)

-- | 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.
updateCustomRoutingAcceleratorAttributes_flowLogsS3Bucket :: Lens.Lens' UpdateCustomRoutingAcceleratorAttributes (Prelude.Maybe Prelude.Text)
updateCustomRoutingAcceleratorAttributes_flowLogsS3Bucket :: Lens' UpdateCustomRoutingAcceleratorAttributes (Maybe Text)
updateCustomRoutingAcceleratorAttributes_flowLogsS3Bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCustomRoutingAcceleratorAttributes' {Maybe Text
flowLogsS3Bucket :: Maybe Text
$sel:flowLogsS3Bucket:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> Maybe Text
flowLogsS3Bucket} -> Maybe Text
flowLogsS3Bucket) (\s :: UpdateCustomRoutingAcceleratorAttributes
s@UpdateCustomRoutingAcceleratorAttributes' {} Maybe Text
a -> UpdateCustomRoutingAcceleratorAttributes
s {$sel:flowLogsS3Bucket:UpdateCustomRoutingAcceleratorAttributes' :: Maybe Text
flowLogsS3Bucket = Maybe Text
a} :: UpdateCustomRoutingAcceleratorAttributes)

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

-- | The Amazon Resource Name (ARN) of the custom routing accelerator to
-- update attributes for.
updateCustomRoutingAcceleratorAttributes_acceleratorArn :: Lens.Lens' UpdateCustomRoutingAcceleratorAttributes Prelude.Text
updateCustomRoutingAcceleratorAttributes_acceleratorArn :: Lens' UpdateCustomRoutingAcceleratorAttributes Text
updateCustomRoutingAcceleratorAttributes_acceleratorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCustomRoutingAcceleratorAttributes' {Text
acceleratorArn :: Text
$sel:acceleratorArn:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> Text
acceleratorArn} -> Text
acceleratorArn) (\s :: UpdateCustomRoutingAcceleratorAttributes
s@UpdateCustomRoutingAcceleratorAttributes' {} Text
a -> UpdateCustomRoutingAcceleratorAttributes
s {$sel:acceleratorArn:UpdateCustomRoutingAcceleratorAttributes' :: Text
acceleratorArn = Text
a} :: UpdateCustomRoutingAcceleratorAttributes)

instance
  Core.AWSRequest
    UpdateCustomRoutingAcceleratorAttributes
  where
  type
    AWSResponse
      UpdateCustomRoutingAcceleratorAttributes =
      UpdateCustomRoutingAcceleratorAttributesResponse
  request :: (Service -> Service)
-> UpdateCustomRoutingAcceleratorAttributes
-> Request UpdateCustomRoutingAcceleratorAttributes
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 UpdateCustomRoutingAcceleratorAttributes
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse UpdateCustomRoutingAcceleratorAttributes)))
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 CustomRoutingAcceleratorAttributes
-> Int -> UpdateCustomRoutingAcceleratorAttributesResponse
UpdateCustomRoutingAcceleratorAttributesResponse'
            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
    UpdateCustomRoutingAcceleratorAttributes
  where
  hashWithSalt :: Int -> UpdateCustomRoutingAcceleratorAttributes -> Int
hashWithSalt
    Int
_salt
    UpdateCustomRoutingAcceleratorAttributes' {Maybe Bool
Maybe Text
Text
acceleratorArn :: Text
flowLogsS3Prefix :: Maybe Text
flowLogsS3Bucket :: Maybe Text
flowLogsEnabled :: Maybe Bool
$sel:acceleratorArn:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> Text
$sel:flowLogsS3Prefix:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> Maybe Text
$sel:flowLogsS3Bucket:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> Maybe Text
$sel:flowLogsEnabled:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> 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
    UpdateCustomRoutingAcceleratorAttributes
  where
  rnf :: UpdateCustomRoutingAcceleratorAttributes -> ()
rnf UpdateCustomRoutingAcceleratorAttributes' {Maybe Bool
Maybe Text
Text
acceleratorArn :: Text
flowLogsS3Prefix :: Maybe Text
flowLogsS3Bucket :: Maybe Text
flowLogsEnabled :: Maybe Bool
$sel:acceleratorArn:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> Text
$sel:flowLogsS3Prefix:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> Maybe Text
$sel:flowLogsS3Bucket:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> Maybe Text
$sel:flowLogsEnabled:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> 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
    UpdateCustomRoutingAcceleratorAttributes
  where
  toHeaders :: UpdateCustomRoutingAcceleratorAttributes -> 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.UpdateCustomRoutingAcceleratorAttributes" ::
                          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
    UpdateCustomRoutingAcceleratorAttributes
  where
  toJSON :: UpdateCustomRoutingAcceleratorAttributes -> Value
toJSON UpdateCustomRoutingAcceleratorAttributes' {Maybe Bool
Maybe Text
Text
acceleratorArn :: Text
flowLogsS3Prefix :: Maybe Text
flowLogsS3Bucket :: Maybe Text
flowLogsEnabled :: Maybe Bool
$sel:acceleratorArn:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> Text
$sel:flowLogsS3Prefix:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> Maybe Text
$sel:flowLogsS3Bucket:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> Maybe Text
$sel:flowLogsEnabled:UpdateCustomRoutingAcceleratorAttributes' :: UpdateCustomRoutingAcceleratorAttributes -> 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
    UpdateCustomRoutingAcceleratorAttributes
  where
  toPath :: UpdateCustomRoutingAcceleratorAttributes -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'UpdateCustomRoutingAcceleratorAttributesResponse' 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', 'updateCustomRoutingAcceleratorAttributesResponse_acceleratorAttributes' - Updated custom routing accelerator.
--
-- 'httpStatus', 'updateCustomRoutingAcceleratorAttributesResponse_httpStatus' - The response's http status code.
newUpdateCustomRoutingAcceleratorAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateCustomRoutingAcceleratorAttributesResponse
newUpdateCustomRoutingAcceleratorAttributesResponse :: Int -> UpdateCustomRoutingAcceleratorAttributesResponse
newUpdateCustomRoutingAcceleratorAttributesResponse
  Int
pHttpStatus_ =
    UpdateCustomRoutingAcceleratorAttributesResponse'
      { $sel:acceleratorAttributes:UpdateCustomRoutingAcceleratorAttributesResponse' :: Maybe CustomRoutingAcceleratorAttributes
acceleratorAttributes =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:UpdateCustomRoutingAcceleratorAttributesResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Updated custom routing accelerator.
updateCustomRoutingAcceleratorAttributesResponse_acceleratorAttributes :: Lens.Lens' UpdateCustomRoutingAcceleratorAttributesResponse (Prelude.Maybe CustomRoutingAcceleratorAttributes)
updateCustomRoutingAcceleratorAttributesResponse_acceleratorAttributes :: Lens'
  UpdateCustomRoutingAcceleratorAttributesResponse
  (Maybe CustomRoutingAcceleratorAttributes)
updateCustomRoutingAcceleratorAttributesResponse_acceleratorAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCustomRoutingAcceleratorAttributesResponse' {Maybe CustomRoutingAcceleratorAttributes
acceleratorAttributes :: Maybe CustomRoutingAcceleratorAttributes
$sel:acceleratorAttributes:UpdateCustomRoutingAcceleratorAttributesResponse' :: UpdateCustomRoutingAcceleratorAttributesResponse
-> Maybe CustomRoutingAcceleratorAttributes
acceleratorAttributes} -> Maybe CustomRoutingAcceleratorAttributes
acceleratorAttributes) (\s :: UpdateCustomRoutingAcceleratorAttributesResponse
s@UpdateCustomRoutingAcceleratorAttributesResponse' {} Maybe CustomRoutingAcceleratorAttributes
a -> UpdateCustomRoutingAcceleratorAttributesResponse
s {$sel:acceleratorAttributes:UpdateCustomRoutingAcceleratorAttributesResponse' :: Maybe CustomRoutingAcceleratorAttributes
acceleratorAttributes = Maybe CustomRoutingAcceleratorAttributes
a} :: UpdateCustomRoutingAcceleratorAttributesResponse)

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

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