{-# 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.MQ.UpdateBroker
-- 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 a pending configuration change to a broker.
module Amazonka.MQ.UpdateBroker
  ( -- * Creating a Request
    UpdateBroker (..),
    newUpdateBroker,

    -- * Request Lenses
    updateBroker_authenticationStrategy,
    updateBroker_autoMinorVersionUpgrade,
    updateBroker_configuration,
    updateBroker_engineVersion,
    updateBroker_hostInstanceType,
    updateBroker_ldapServerMetadata,
    updateBroker_logs,
    updateBroker_maintenanceWindowStartTime,
    updateBroker_securityGroups,
    updateBroker_brokerId,

    -- * Destructuring the Response
    UpdateBrokerResponse (..),
    newUpdateBrokerResponse,

    -- * Response Lenses
    updateBrokerResponse_authenticationStrategy,
    updateBrokerResponse_autoMinorVersionUpgrade,
    updateBrokerResponse_brokerId,
    updateBrokerResponse_configuration,
    updateBrokerResponse_engineVersion,
    updateBrokerResponse_hostInstanceType,
    updateBrokerResponse_ldapServerMetadata,
    updateBrokerResponse_logs,
    updateBrokerResponse_maintenanceWindowStartTime,
    updateBrokerResponse_securityGroups,
    updateBrokerResponse_httpStatus,
  )
where

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

-- | Updates the broker using the specified properties.
--
-- /See:/ 'newUpdateBroker' smart constructor.
data UpdateBroker = UpdateBroker'
  { -- | Optional. The authentication strategy used to secure the broker. The
    -- default is SIMPLE.
    UpdateBroker -> Maybe AuthenticationStrategy
authenticationStrategy :: Prelude.Maybe AuthenticationStrategy,
    -- | Enables automatic upgrades to new minor versions for brokers, as new
    -- versions are released and supported by Amazon MQ. Automatic upgrades
    -- occur during the scheduled maintenance window of the broker or after a
    -- manual broker reboot.
    UpdateBroker -> Maybe Bool
autoMinorVersionUpgrade :: Prelude.Maybe Prelude.Bool,
    -- | A list of information about the configuration.
    UpdateBroker -> Maybe ConfigurationId
configuration :: Prelude.Maybe ConfigurationId,
    -- | The broker engine version. For a list of supported engine versions, see
    -- <https://docs.aws.amazon.com//amazon-mq/latest/developer-guide/broker-engine.html Supported engines>.
    UpdateBroker -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | The broker\'s host instance type to upgrade to. For a list of supported
    -- instance types, see
    -- <https://docs.aws.amazon.com//amazon-mq/latest/developer-guide/broker.html#broker-instance-types Broker instance types>.
    UpdateBroker -> Maybe Text
hostInstanceType :: Prelude.Maybe Prelude.Text,
    -- | Optional. The metadata of the LDAP server used to authenticate and
    -- authorize connections to the broker. Does not apply to RabbitMQ brokers.
    UpdateBroker -> Maybe LdapServerMetadataInput
ldapServerMetadata :: Prelude.Maybe LdapServerMetadataInput,
    -- | Enables Amazon CloudWatch logging for brokers.
    UpdateBroker -> Maybe Logs
logs :: Prelude.Maybe Logs,
    -- | The parameters that determine the WeeklyStartTime.
    UpdateBroker -> Maybe WeeklyStartTime
maintenanceWindowStartTime :: Prelude.Maybe WeeklyStartTime,
    -- | The list of security groups (1 minimum, 5 maximum) that authorizes
    -- connections to brokers.
    UpdateBroker -> Maybe [Text]
securityGroups :: Prelude.Maybe [Prelude.Text],
    -- | The unique ID that Amazon MQ generates for the broker.
    UpdateBroker -> Text
brokerId :: Prelude.Text
  }
  deriving (UpdateBroker -> UpdateBroker -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBroker -> UpdateBroker -> Bool
$c/= :: UpdateBroker -> UpdateBroker -> Bool
== :: UpdateBroker -> UpdateBroker -> Bool
$c== :: UpdateBroker -> UpdateBroker -> Bool
Prelude.Eq, ReadPrec [UpdateBroker]
ReadPrec UpdateBroker
Int -> ReadS UpdateBroker
ReadS [UpdateBroker]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateBroker]
$creadListPrec :: ReadPrec [UpdateBroker]
readPrec :: ReadPrec UpdateBroker
$creadPrec :: ReadPrec UpdateBroker
readList :: ReadS [UpdateBroker]
$creadList :: ReadS [UpdateBroker]
readsPrec :: Int -> ReadS UpdateBroker
$creadsPrec :: Int -> ReadS UpdateBroker
Prelude.Read, Int -> UpdateBroker -> ShowS
[UpdateBroker] -> ShowS
UpdateBroker -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBroker] -> ShowS
$cshowList :: [UpdateBroker] -> ShowS
show :: UpdateBroker -> String
$cshow :: UpdateBroker -> String
showsPrec :: Int -> UpdateBroker -> ShowS
$cshowsPrec :: Int -> UpdateBroker -> ShowS
Prelude.Show, forall x. Rep UpdateBroker x -> UpdateBroker
forall x. UpdateBroker -> Rep UpdateBroker x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBroker x -> UpdateBroker
$cfrom :: forall x. UpdateBroker -> Rep UpdateBroker x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBroker' 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:
--
-- 'authenticationStrategy', 'updateBroker_authenticationStrategy' - Optional. The authentication strategy used to secure the broker. The
-- default is SIMPLE.
--
-- 'autoMinorVersionUpgrade', 'updateBroker_autoMinorVersionUpgrade' - Enables automatic upgrades to new minor versions for brokers, as new
-- versions are released and supported by Amazon MQ. Automatic upgrades
-- occur during the scheduled maintenance window of the broker or after a
-- manual broker reboot.
--
-- 'configuration', 'updateBroker_configuration' - A list of information about the configuration.
--
-- 'engineVersion', 'updateBroker_engineVersion' - The broker engine version. For a list of supported engine versions, see
-- <https://docs.aws.amazon.com//amazon-mq/latest/developer-guide/broker-engine.html Supported engines>.
--
-- 'hostInstanceType', 'updateBroker_hostInstanceType' - The broker\'s host instance type to upgrade to. For a list of supported
-- instance types, see
-- <https://docs.aws.amazon.com//amazon-mq/latest/developer-guide/broker.html#broker-instance-types Broker instance types>.
--
-- 'ldapServerMetadata', 'updateBroker_ldapServerMetadata' - Optional. The metadata of the LDAP server used to authenticate and
-- authorize connections to the broker. Does not apply to RabbitMQ brokers.
--
-- 'logs', 'updateBroker_logs' - Enables Amazon CloudWatch logging for brokers.
--
-- 'maintenanceWindowStartTime', 'updateBroker_maintenanceWindowStartTime' - The parameters that determine the WeeklyStartTime.
--
-- 'securityGroups', 'updateBroker_securityGroups' - The list of security groups (1 minimum, 5 maximum) that authorizes
-- connections to brokers.
--
-- 'brokerId', 'updateBroker_brokerId' - The unique ID that Amazon MQ generates for the broker.
newUpdateBroker ::
  -- | 'brokerId'
  Prelude.Text ->
  UpdateBroker
newUpdateBroker :: Text -> UpdateBroker
newUpdateBroker Text
pBrokerId_ =
  UpdateBroker'
    { $sel:authenticationStrategy:UpdateBroker' :: Maybe AuthenticationStrategy
authenticationStrategy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:autoMinorVersionUpgrade:UpdateBroker' :: Maybe Bool
autoMinorVersionUpgrade = forall a. Maybe a
Prelude.Nothing,
      $sel:configuration:UpdateBroker' :: Maybe ConfigurationId
configuration = forall a. Maybe a
Prelude.Nothing,
      $sel:engineVersion:UpdateBroker' :: Maybe Text
engineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:hostInstanceType:UpdateBroker' :: Maybe Text
hostInstanceType = forall a. Maybe a
Prelude.Nothing,
      $sel:ldapServerMetadata:UpdateBroker' :: Maybe LdapServerMetadataInput
ldapServerMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:logs:UpdateBroker' :: Maybe Logs
logs = forall a. Maybe a
Prelude.Nothing,
      $sel:maintenanceWindowStartTime:UpdateBroker' :: Maybe WeeklyStartTime
maintenanceWindowStartTime = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroups:UpdateBroker' :: Maybe [Text]
securityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:brokerId:UpdateBroker' :: Text
brokerId = Text
pBrokerId_
    }

-- | Optional. The authentication strategy used to secure the broker. The
-- default is SIMPLE.
updateBroker_authenticationStrategy :: Lens.Lens' UpdateBroker (Prelude.Maybe AuthenticationStrategy)
updateBroker_authenticationStrategy :: Lens' UpdateBroker (Maybe AuthenticationStrategy)
updateBroker_authenticationStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBroker' {Maybe AuthenticationStrategy
authenticationStrategy :: Maybe AuthenticationStrategy
$sel:authenticationStrategy:UpdateBroker' :: UpdateBroker -> Maybe AuthenticationStrategy
authenticationStrategy} -> Maybe AuthenticationStrategy
authenticationStrategy) (\s :: UpdateBroker
s@UpdateBroker' {} Maybe AuthenticationStrategy
a -> UpdateBroker
s {$sel:authenticationStrategy:UpdateBroker' :: Maybe AuthenticationStrategy
authenticationStrategy = Maybe AuthenticationStrategy
a} :: UpdateBroker)

-- | Enables automatic upgrades to new minor versions for brokers, as new
-- versions are released and supported by Amazon MQ. Automatic upgrades
-- occur during the scheduled maintenance window of the broker or after a
-- manual broker reboot.
updateBroker_autoMinorVersionUpgrade :: Lens.Lens' UpdateBroker (Prelude.Maybe Prelude.Bool)
updateBroker_autoMinorVersionUpgrade :: Lens' UpdateBroker (Maybe Bool)
updateBroker_autoMinorVersionUpgrade = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBroker' {Maybe Bool
autoMinorVersionUpgrade :: Maybe Bool
$sel:autoMinorVersionUpgrade:UpdateBroker' :: UpdateBroker -> Maybe Bool
autoMinorVersionUpgrade} -> Maybe Bool
autoMinorVersionUpgrade) (\s :: UpdateBroker
s@UpdateBroker' {} Maybe Bool
a -> UpdateBroker
s {$sel:autoMinorVersionUpgrade:UpdateBroker' :: Maybe Bool
autoMinorVersionUpgrade = Maybe Bool
a} :: UpdateBroker)

-- | A list of information about the configuration.
updateBroker_configuration :: Lens.Lens' UpdateBroker (Prelude.Maybe ConfigurationId)
updateBroker_configuration :: Lens' UpdateBroker (Maybe ConfigurationId)
updateBroker_configuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBroker' {Maybe ConfigurationId
configuration :: Maybe ConfigurationId
$sel:configuration:UpdateBroker' :: UpdateBroker -> Maybe ConfigurationId
configuration} -> Maybe ConfigurationId
configuration) (\s :: UpdateBroker
s@UpdateBroker' {} Maybe ConfigurationId
a -> UpdateBroker
s {$sel:configuration:UpdateBroker' :: Maybe ConfigurationId
configuration = Maybe ConfigurationId
a} :: UpdateBroker)

-- | The broker engine version. For a list of supported engine versions, see
-- <https://docs.aws.amazon.com//amazon-mq/latest/developer-guide/broker-engine.html Supported engines>.
updateBroker_engineVersion :: Lens.Lens' UpdateBroker (Prelude.Maybe Prelude.Text)
updateBroker_engineVersion :: Lens' UpdateBroker (Maybe Text)
updateBroker_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBroker' {Maybe Text
engineVersion :: Maybe Text
$sel:engineVersion:UpdateBroker' :: UpdateBroker -> Maybe Text
engineVersion} -> Maybe Text
engineVersion) (\s :: UpdateBroker
s@UpdateBroker' {} Maybe Text
a -> UpdateBroker
s {$sel:engineVersion:UpdateBroker' :: Maybe Text
engineVersion = Maybe Text
a} :: UpdateBroker)

-- | The broker\'s host instance type to upgrade to. For a list of supported
-- instance types, see
-- <https://docs.aws.amazon.com//amazon-mq/latest/developer-guide/broker.html#broker-instance-types Broker instance types>.
updateBroker_hostInstanceType :: Lens.Lens' UpdateBroker (Prelude.Maybe Prelude.Text)
updateBroker_hostInstanceType :: Lens' UpdateBroker (Maybe Text)
updateBroker_hostInstanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBroker' {Maybe Text
hostInstanceType :: Maybe Text
$sel:hostInstanceType:UpdateBroker' :: UpdateBroker -> Maybe Text
hostInstanceType} -> Maybe Text
hostInstanceType) (\s :: UpdateBroker
s@UpdateBroker' {} Maybe Text
a -> UpdateBroker
s {$sel:hostInstanceType:UpdateBroker' :: Maybe Text
hostInstanceType = Maybe Text
a} :: UpdateBroker)

-- | Optional. The metadata of the LDAP server used to authenticate and
-- authorize connections to the broker. Does not apply to RabbitMQ brokers.
updateBroker_ldapServerMetadata :: Lens.Lens' UpdateBroker (Prelude.Maybe LdapServerMetadataInput)
updateBroker_ldapServerMetadata :: Lens' UpdateBroker (Maybe LdapServerMetadataInput)
updateBroker_ldapServerMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBroker' {Maybe LdapServerMetadataInput
ldapServerMetadata :: Maybe LdapServerMetadataInput
$sel:ldapServerMetadata:UpdateBroker' :: UpdateBroker -> Maybe LdapServerMetadataInput
ldapServerMetadata} -> Maybe LdapServerMetadataInput
ldapServerMetadata) (\s :: UpdateBroker
s@UpdateBroker' {} Maybe LdapServerMetadataInput
a -> UpdateBroker
s {$sel:ldapServerMetadata:UpdateBroker' :: Maybe LdapServerMetadataInput
ldapServerMetadata = Maybe LdapServerMetadataInput
a} :: UpdateBroker)

-- | Enables Amazon CloudWatch logging for brokers.
updateBroker_logs :: Lens.Lens' UpdateBroker (Prelude.Maybe Logs)
updateBroker_logs :: Lens' UpdateBroker (Maybe Logs)
updateBroker_logs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBroker' {Maybe Logs
logs :: Maybe Logs
$sel:logs:UpdateBroker' :: UpdateBroker -> Maybe Logs
logs} -> Maybe Logs
logs) (\s :: UpdateBroker
s@UpdateBroker' {} Maybe Logs
a -> UpdateBroker
s {$sel:logs:UpdateBroker' :: Maybe Logs
logs = Maybe Logs
a} :: UpdateBroker)

-- | The parameters that determine the WeeklyStartTime.
updateBroker_maintenanceWindowStartTime :: Lens.Lens' UpdateBroker (Prelude.Maybe WeeklyStartTime)
updateBroker_maintenanceWindowStartTime :: Lens' UpdateBroker (Maybe WeeklyStartTime)
updateBroker_maintenanceWindowStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBroker' {Maybe WeeklyStartTime
maintenanceWindowStartTime :: Maybe WeeklyStartTime
$sel:maintenanceWindowStartTime:UpdateBroker' :: UpdateBroker -> Maybe WeeklyStartTime
maintenanceWindowStartTime} -> Maybe WeeklyStartTime
maintenanceWindowStartTime) (\s :: UpdateBroker
s@UpdateBroker' {} Maybe WeeklyStartTime
a -> UpdateBroker
s {$sel:maintenanceWindowStartTime:UpdateBroker' :: Maybe WeeklyStartTime
maintenanceWindowStartTime = Maybe WeeklyStartTime
a} :: UpdateBroker)

-- | The list of security groups (1 minimum, 5 maximum) that authorizes
-- connections to brokers.
updateBroker_securityGroups :: Lens.Lens' UpdateBroker (Prelude.Maybe [Prelude.Text])
updateBroker_securityGroups :: Lens' UpdateBroker (Maybe [Text])
updateBroker_securityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBroker' {Maybe [Text]
securityGroups :: Maybe [Text]
$sel:securityGroups:UpdateBroker' :: UpdateBroker -> Maybe [Text]
securityGroups} -> Maybe [Text]
securityGroups) (\s :: UpdateBroker
s@UpdateBroker' {} Maybe [Text]
a -> UpdateBroker
s {$sel:securityGroups:UpdateBroker' :: Maybe [Text]
securityGroups = Maybe [Text]
a} :: UpdateBroker) 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 unique ID that Amazon MQ generates for the broker.
updateBroker_brokerId :: Lens.Lens' UpdateBroker Prelude.Text
updateBroker_brokerId :: Lens' UpdateBroker Text
updateBroker_brokerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBroker' {Text
brokerId :: Text
$sel:brokerId:UpdateBroker' :: UpdateBroker -> Text
brokerId} -> Text
brokerId) (\s :: UpdateBroker
s@UpdateBroker' {} Text
a -> UpdateBroker
s {$sel:brokerId:UpdateBroker' :: Text
brokerId = Text
a} :: UpdateBroker)

instance Core.AWSRequest UpdateBroker where
  type AWSResponse UpdateBroker = UpdateBrokerResponse
  request :: (Service -> Service) -> UpdateBroker -> Request UpdateBroker
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateBroker
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateBroker)))
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 AuthenticationStrategy
-> Maybe Bool
-> Maybe Text
-> Maybe ConfigurationId
-> Maybe Text
-> Maybe Text
-> Maybe LdapServerMetadataOutput
-> Maybe Logs
-> Maybe WeeklyStartTime
-> Maybe [Text]
-> Int
-> UpdateBrokerResponse
UpdateBrokerResponse'
            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
"authenticationStrategy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"autoMinorVersionUpgrade")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"brokerId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"configuration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"engineVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"hostInstanceType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ldapServerMetadata")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"logs")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"maintenanceWindowStartTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"securityGroups" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateBroker where
  hashWithSalt :: Int -> UpdateBroker -> Int
hashWithSalt Int
_salt UpdateBroker' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe AuthenticationStrategy
Maybe ConfigurationId
Maybe LdapServerMetadataInput
Maybe Logs
Maybe WeeklyStartTime
Text
brokerId :: Text
securityGroups :: Maybe [Text]
maintenanceWindowStartTime :: Maybe WeeklyStartTime
logs :: Maybe Logs
ldapServerMetadata :: Maybe LdapServerMetadataInput
hostInstanceType :: Maybe Text
engineVersion :: Maybe Text
configuration :: Maybe ConfigurationId
autoMinorVersionUpgrade :: Maybe Bool
authenticationStrategy :: Maybe AuthenticationStrategy
$sel:brokerId:UpdateBroker' :: UpdateBroker -> Text
$sel:securityGroups:UpdateBroker' :: UpdateBroker -> Maybe [Text]
$sel:maintenanceWindowStartTime:UpdateBroker' :: UpdateBroker -> Maybe WeeklyStartTime
$sel:logs:UpdateBroker' :: UpdateBroker -> Maybe Logs
$sel:ldapServerMetadata:UpdateBroker' :: UpdateBroker -> Maybe LdapServerMetadataInput
$sel:hostInstanceType:UpdateBroker' :: UpdateBroker -> Maybe Text
$sel:engineVersion:UpdateBroker' :: UpdateBroker -> Maybe Text
$sel:configuration:UpdateBroker' :: UpdateBroker -> Maybe ConfigurationId
$sel:autoMinorVersionUpgrade:UpdateBroker' :: UpdateBroker -> Maybe Bool
$sel:authenticationStrategy:UpdateBroker' :: UpdateBroker -> Maybe AuthenticationStrategy
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AuthenticationStrategy
authenticationStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoMinorVersionUpgrade
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConfigurationId
configuration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostInstanceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LdapServerMetadataInput
ldapServerMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Logs
logs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WeeklyStartTime
maintenanceWindowStartTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
brokerId

instance Prelude.NFData UpdateBroker where
  rnf :: UpdateBroker -> ()
rnf UpdateBroker' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe AuthenticationStrategy
Maybe ConfigurationId
Maybe LdapServerMetadataInput
Maybe Logs
Maybe WeeklyStartTime
Text
brokerId :: Text
securityGroups :: Maybe [Text]
maintenanceWindowStartTime :: Maybe WeeklyStartTime
logs :: Maybe Logs
ldapServerMetadata :: Maybe LdapServerMetadataInput
hostInstanceType :: Maybe Text
engineVersion :: Maybe Text
configuration :: Maybe ConfigurationId
autoMinorVersionUpgrade :: Maybe Bool
authenticationStrategy :: Maybe AuthenticationStrategy
$sel:brokerId:UpdateBroker' :: UpdateBroker -> Text
$sel:securityGroups:UpdateBroker' :: UpdateBroker -> Maybe [Text]
$sel:maintenanceWindowStartTime:UpdateBroker' :: UpdateBroker -> Maybe WeeklyStartTime
$sel:logs:UpdateBroker' :: UpdateBroker -> Maybe Logs
$sel:ldapServerMetadata:UpdateBroker' :: UpdateBroker -> Maybe LdapServerMetadataInput
$sel:hostInstanceType:UpdateBroker' :: UpdateBroker -> Maybe Text
$sel:engineVersion:UpdateBroker' :: UpdateBroker -> Maybe Text
$sel:configuration:UpdateBroker' :: UpdateBroker -> Maybe ConfigurationId
$sel:autoMinorVersionUpgrade:UpdateBroker' :: UpdateBroker -> Maybe Bool
$sel:authenticationStrategy:UpdateBroker' :: UpdateBroker -> Maybe AuthenticationStrategy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AuthenticationStrategy
authenticationStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoMinorVersionUpgrade
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConfigurationId
configuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostInstanceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LdapServerMetadataInput
ldapServerMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Logs
logs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WeeklyStartTime
maintenanceWindowStartTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
securityGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
brokerId

instance Data.ToHeaders UpdateBroker where
  toHeaders :: UpdateBroker -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateBroker where
  toJSON :: UpdateBroker -> Value
toJSON UpdateBroker' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe AuthenticationStrategy
Maybe ConfigurationId
Maybe LdapServerMetadataInput
Maybe Logs
Maybe WeeklyStartTime
Text
brokerId :: Text
securityGroups :: Maybe [Text]
maintenanceWindowStartTime :: Maybe WeeklyStartTime
logs :: Maybe Logs
ldapServerMetadata :: Maybe LdapServerMetadataInput
hostInstanceType :: Maybe Text
engineVersion :: Maybe Text
configuration :: Maybe ConfigurationId
autoMinorVersionUpgrade :: Maybe Bool
authenticationStrategy :: Maybe AuthenticationStrategy
$sel:brokerId:UpdateBroker' :: UpdateBroker -> Text
$sel:securityGroups:UpdateBroker' :: UpdateBroker -> Maybe [Text]
$sel:maintenanceWindowStartTime:UpdateBroker' :: UpdateBroker -> Maybe WeeklyStartTime
$sel:logs:UpdateBroker' :: UpdateBroker -> Maybe Logs
$sel:ldapServerMetadata:UpdateBroker' :: UpdateBroker -> Maybe LdapServerMetadataInput
$sel:hostInstanceType:UpdateBroker' :: UpdateBroker -> Maybe Text
$sel:engineVersion:UpdateBroker' :: UpdateBroker -> Maybe Text
$sel:configuration:UpdateBroker' :: UpdateBroker -> Maybe ConfigurationId
$sel:autoMinorVersionUpgrade:UpdateBroker' :: UpdateBroker -> Maybe Bool
$sel:authenticationStrategy:UpdateBroker' :: UpdateBroker -> Maybe AuthenticationStrategy
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"authenticationStrategy" 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 AuthenticationStrategy
authenticationStrategy,
            (Key
"autoMinorVersionUpgrade" 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
autoMinorVersionUpgrade,
            (Key
"configuration" 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 ConfigurationId
configuration,
            (Key
"engineVersion" 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
engineVersion,
            (Key
"hostInstanceType" 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
hostInstanceType,
            (Key
"ldapServerMetadata" 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 LdapServerMetadataInput
ldapServerMetadata,
            (Key
"logs" 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 Logs
logs,
            (Key
"maintenanceWindowStartTime" 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 WeeklyStartTime
maintenanceWindowStartTime,
            (Key
"securityGroups" 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]
securityGroups
          ]
      )

instance Data.ToPath UpdateBroker where
  toPath :: UpdateBroker -> ByteString
toPath UpdateBroker' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe AuthenticationStrategy
Maybe ConfigurationId
Maybe LdapServerMetadataInput
Maybe Logs
Maybe WeeklyStartTime
Text
brokerId :: Text
securityGroups :: Maybe [Text]
maintenanceWindowStartTime :: Maybe WeeklyStartTime
logs :: Maybe Logs
ldapServerMetadata :: Maybe LdapServerMetadataInput
hostInstanceType :: Maybe Text
engineVersion :: Maybe Text
configuration :: Maybe ConfigurationId
autoMinorVersionUpgrade :: Maybe Bool
authenticationStrategy :: Maybe AuthenticationStrategy
$sel:brokerId:UpdateBroker' :: UpdateBroker -> Text
$sel:securityGroups:UpdateBroker' :: UpdateBroker -> Maybe [Text]
$sel:maintenanceWindowStartTime:UpdateBroker' :: UpdateBroker -> Maybe WeeklyStartTime
$sel:logs:UpdateBroker' :: UpdateBroker -> Maybe Logs
$sel:ldapServerMetadata:UpdateBroker' :: UpdateBroker -> Maybe LdapServerMetadataInput
$sel:hostInstanceType:UpdateBroker' :: UpdateBroker -> Maybe Text
$sel:engineVersion:UpdateBroker' :: UpdateBroker -> Maybe Text
$sel:configuration:UpdateBroker' :: UpdateBroker -> Maybe ConfigurationId
$sel:autoMinorVersionUpgrade:UpdateBroker' :: UpdateBroker -> Maybe Bool
$sel:authenticationStrategy:UpdateBroker' :: UpdateBroker -> Maybe AuthenticationStrategy
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/v1/brokers/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
brokerId]

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

-- | /See:/ 'newUpdateBrokerResponse' smart constructor.
data UpdateBrokerResponse = UpdateBrokerResponse'
  { -- | Optional. The authentication strategy used to secure the broker. The
    -- default is SIMPLE.
    UpdateBrokerResponse -> Maybe AuthenticationStrategy
authenticationStrategy :: Prelude.Maybe AuthenticationStrategy,
    -- | The new boolean value that specifies whether broker engines
    -- automatically upgrade to new minor versions as new versions are released
    -- and supported by Amazon MQ.
    UpdateBrokerResponse -> Maybe Bool
autoMinorVersionUpgrade :: Prelude.Maybe Prelude.Bool,
    -- | Required. The unique ID that Amazon MQ generates for the broker.
    UpdateBrokerResponse -> Maybe Text
brokerId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the updated configuration.
    UpdateBrokerResponse -> Maybe ConfigurationId
configuration :: Prelude.Maybe ConfigurationId,
    -- | The broker engine version to upgrade to. For a list of supported engine
    -- versions, see
    -- <https://docs.aws.amazon.com//amazon-mq/latest/developer-guide/broker-engine.html Supported engines>.
    UpdateBrokerResponse -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | The broker\'s host instance type to upgrade to. For a list of supported
    -- instance types, see
    -- <https://docs.aws.amazon.com//amazon-mq/latest/developer-guide/broker.html#broker-instance-types Broker instance types>.
    UpdateBrokerResponse -> Maybe Text
hostInstanceType :: Prelude.Maybe Prelude.Text,
    -- | Optional. The metadata of the LDAP server used to authenticate and
    -- authorize connections to the broker. Does not apply to RabbitMQ brokers.
    UpdateBrokerResponse -> Maybe LdapServerMetadataOutput
ldapServerMetadata :: Prelude.Maybe LdapServerMetadataOutput,
    -- | The list of information about logs to be enabled for the specified
    -- broker.
    UpdateBrokerResponse -> Maybe Logs
logs :: Prelude.Maybe Logs,
    -- | The parameters that determine the WeeklyStartTime.
    UpdateBrokerResponse -> Maybe WeeklyStartTime
maintenanceWindowStartTime :: Prelude.Maybe WeeklyStartTime,
    -- | The list of security groups (1 minimum, 5 maximum) that authorizes
    -- connections to brokers.
    UpdateBrokerResponse -> Maybe [Text]
securityGroups :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    UpdateBrokerResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateBrokerResponse -> UpdateBrokerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBrokerResponse -> UpdateBrokerResponse -> Bool
$c/= :: UpdateBrokerResponse -> UpdateBrokerResponse -> Bool
== :: UpdateBrokerResponse -> UpdateBrokerResponse -> Bool
$c== :: UpdateBrokerResponse -> UpdateBrokerResponse -> Bool
Prelude.Eq, ReadPrec [UpdateBrokerResponse]
ReadPrec UpdateBrokerResponse
Int -> ReadS UpdateBrokerResponse
ReadS [UpdateBrokerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateBrokerResponse]
$creadListPrec :: ReadPrec [UpdateBrokerResponse]
readPrec :: ReadPrec UpdateBrokerResponse
$creadPrec :: ReadPrec UpdateBrokerResponse
readList :: ReadS [UpdateBrokerResponse]
$creadList :: ReadS [UpdateBrokerResponse]
readsPrec :: Int -> ReadS UpdateBrokerResponse
$creadsPrec :: Int -> ReadS UpdateBrokerResponse
Prelude.Read, Int -> UpdateBrokerResponse -> ShowS
[UpdateBrokerResponse] -> ShowS
UpdateBrokerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBrokerResponse] -> ShowS
$cshowList :: [UpdateBrokerResponse] -> ShowS
show :: UpdateBrokerResponse -> String
$cshow :: UpdateBrokerResponse -> String
showsPrec :: Int -> UpdateBrokerResponse -> ShowS
$cshowsPrec :: Int -> UpdateBrokerResponse -> ShowS
Prelude.Show, forall x. Rep UpdateBrokerResponse x -> UpdateBrokerResponse
forall x. UpdateBrokerResponse -> Rep UpdateBrokerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBrokerResponse x -> UpdateBrokerResponse
$cfrom :: forall x. UpdateBrokerResponse -> Rep UpdateBrokerResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBrokerResponse' 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:
--
-- 'authenticationStrategy', 'updateBrokerResponse_authenticationStrategy' - Optional. The authentication strategy used to secure the broker. The
-- default is SIMPLE.
--
-- 'autoMinorVersionUpgrade', 'updateBrokerResponse_autoMinorVersionUpgrade' - The new boolean value that specifies whether broker engines
-- automatically upgrade to new minor versions as new versions are released
-- and supported by Amazon MQ.
--
-- 'brokerId', 'updateBrokerResponse_brokerId' - Required. The unique ID that Amazon MQ generates for the broker.
--
-- 'configuration', 'updateBrokerResponse_configuration' - The ID of the updated configuration.
--
-- 'engineVersion', 'updateBrokerResponse_engineVersion' - The broker engine version to upgrade to. For a list of supported engine
-- versions, see
-- <https://docs.aws.amazon.com//amazon-mq/latest/developer-guide/broker-engine.html Supported engines>.
--
-- 'hostInstanceType', 'updateBrokerResponse_hostInstanceType' - The broker\'s host instance type to upgrade to. For a list of supported
-- instance types, see
-- <https://docs.aws.amazon.com//amazon-mq/latest/developer-guide/broker.html#broker-instance-types Broker instance types>.
--
-- 'ldapServerMetadata', 'updateBrokerResponse_ldapServerMetadata' - Optional. The metadata of the LDAP server used to authenticate and
-- authorize connections to the broker. Does not apply to RabbitMQ brokers.
--
-- 'logs', 'updateBrokerResponse_logs' - The list of information about logs to be enabled for the specified
-- broker.
--
-- 'maintenanceWindowStartTime', 'updateBrokerResponse_maintenanceWindowStartTime' - The parameters that determine the WeeklyStartTime.
--
-- 'securityGroups', 'updateBrokerResponse_securityGroups' - The list of security groups (1 minimum, 5 maximum) that authorizes
-- connections to brokers.
--
-- 'httpStatus', 'updateBrokerResponse_httpStatus' - The response's http status code.
newUpdateBrokerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateBrokerResponse
newUpdateBrokerResponse :: Int -> UpdateBrokerResponse
newUpdateBrokerResponse Int
pHttpStatus_ =
  UpdateBrokerResponse'
    { $sel:authenticationStrategy:UpdateBrokerResponse' :: Maybe AuthenticationStrategy
authenticationStrategy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:autoMinorVersionUpgrade:UpdateBrokerResponse' :: Maybe Bool
autoMinorVersionUpgrade = forall a. Maybe a
Prelude.Nothing,
      $sel:brokerId:UpdateBrokerResponse' :: Maybe Text
brokerId = forall a. Maybe a
Prelude.Nothing,
      $sel:configuration:UpdateBrokerResponse' :: Maybe ConfigurationId
configuration = forall a. Maybe a
Prelude.Nothing,
      $sel:engineVersion:UpdateBrokerResponse' :: Maybe Text
engineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:hostInstanceType:UpdateBrokerResponse' :: Maybe Text
hostInstanceType = forall a. Maybe a
Prelude.Nothing,
      $sel:ldapServerMetadata:UpdateBrokerResponse' :: Maybe LdapServerMetadataOutput
ldapServerMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:logs:UpdateBrokerResponse' :: Maybe Logs
logs = forall a. Maybe a
Prelude.Nothing,
      $sel:maintenanceWindowStartTime:UpdateBrokerResponse' :: Maybe WeeklyStartTime
maintenanceWindowStartTime = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroups:UpdateBrokerResponse' :: Maybe [Text]
securityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateBrokerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Optional. The authentication strategy used to secure the broker. The
-- default is SIMPLE.
updateBrokerResponse_authenticationStrategy :: Lens.Lens' UpdateBrokerResponse (Prelude.Maybe AuthenticationStrategy)
updateBrokerResponse_authenticationStrategy :: Lens' UpdateBrokerResponse (Maybe AuthenticationStrategy)
updateBrokerResponse_authenticationStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrokerResponse' {Maybe AuthenticationStrategy
authenticationStrategy :: Maybe AuthenticationStrategy
$sel:authenticationStrategy:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe AuthenticationStrategy
authenticationStrategy} -> Maybe AuthenticationStrategy
authenticationStrategy) (\s :: UpdateBrokerResponse
s@UpdateBrokerResponse' {} Maybe AuthenticationStrategy
a -> UpdateBrokerResponse
s {$sel:authenticationStrategy:UpdateBrokerResponse' :: Maybe AuthenticationStrategy
authenticationStrategy = Maybe AuthenticationStrategy
a} :: UpdateBrokerResponse)

-- | The new boolean value that specifies whether broker engines
-- automatically upgrade to new minor versions as new versions are released
-- and supported by Amazon MQ.
updateBrokerResponse_autoMinorVersionUpgrade :: Lens.Lens' UpdateBrokerResponse (Prelude.Maybe Prelude.Bool)
updateBrokerResponse_autoMinorVersionUpgrade :: Lens' UpdateBrokerResponse (Maybe Bool)
updateBrokerResponse_autoMinorVersionUpgrade = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrokerResponse' {Maybe Bool
autoMinorVersionUpgrade :: Maybe Bool
$sel:autoMinorVersionUpgrade:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe Bool
autoMinorVersionUpgrade} -> Maybe Bool
autoMinorVersionUpgrade) (\s :: UpdateBrokerResponse
s@UpdateBrokerResponse' {} Maybe Bool
a -> UpdateBrokerResponse
s {$sel:autoMinorVersionUpgrade:UpdateBrokerResponse' :: Maybe Bool
autoMinorVersionUpgrade = Maybe Bool
a} :: UpdateBrokerResponse)

-- | Required. The unique ID that Amazon MQ generates for the broker.
updateBrokerResponse_brokerId :: Lens.Lens' UpdateBrokerResponse (Prelude.Maybe Prelude.Text)
updateBrokerResponse_brokerId :: Lens' UpdateBrokerResponse (Maybe Text)
updateBrokerResponse_brokerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrokerResponse' {Maybe Text
brokerId :: Maybe Text
$sel:brokerId:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe Text
brokerId} -> Maybe Text
brokerId) (\s :: UpdateBrokerResponse
s@UpdateBrokerResponse' {} Maybe Text
a -> UpdateBrokerResponse
s {$sel:brokerId:UpdateBrokerResponse' :: Maybe Text
brokerId = Maybe Text
a} :: UpdateBrokerResponse)

-- | The ID of the updated configuration.
updateBrokerResponse_configuration :: Lens.Lens' UpdateBrokerResponse (Prelude.Maybe ConfigurationId)
updateBrokerResponse_configuration :: Lens' UpdateBrokerResponse (Maybe ConfigurationId)
updateBrokerResponse_configuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrokerResponse' {Maybe ConfigurationId
configuration :: Maybe ConfigurationId
$sel:configuration:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe ConfigurationId
configuration} -> Maybe ConfigurationId
configuration) (\s :: UpdateBrokerResponse
s@UpdateBrokerResponse' {} Maybe ConfigurationId
a -> UpdateBrokerResponse
s {$sel:configuration:UpdateBrokerResponse' :: Maybe ConfigurationId
configuration = Maybe ConfigurationId
a} :: UpdateBrokerResponse)

-- | The broker engine version to upgrade to. For a list of supported engine
-- versions, see
-- <https://docs.aws.amazon.com//amazon-mq/latest/developer-guide/broker-engine.html Supported engines>.
updateBrokerResponse_engineVersion :: Lens.Lens' UpdateBrokerResponse (Prelude.Maybe Prelude.Text)
updateBrokerResponse_engineVersion :: Lens' UpdateBrokerResponse (Maybe Text)
updateBrokerResponse_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrokerResponse' {Maybe Text
engineVersion :: Maybe Text
$sel:engineVersion:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe Text
engineVersion} -> Maybe Text
engineVersion) (\s :: UpdateBrokerResponse
s@UpdateBrokerResponse' {} Maybe Text
a -> UpdateBrokerResponse
s {$sel:engineVersion:UpdateBrokerResponse' :: Maybe Text
engineVersion = Maybe Text
a} :: UpdateBrokerResponse)

-- | The broker\'s host instance type to upgrade to. For a list of supported
-- instance types, see
-- <https://docs.aws.amazon.com//amazon-mq/latest/developer-guide/broker.html#broker-instance-types Broker instance types>.
updateBrokerResponse_hostInstanceType :: Lens.Lens' UpdateBrokerResponse (Prelude.Maybe Prelude.Text)
updateBrokerResponse_hostInstanceType :: Lens' UpdateBrokerResponse (Maybe Text)
updateBrokerResponse_hostInstanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrokerResponse' {Maybe Text
hostInstanceType :: Maybe Text
$sel:hostInstanceType:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe Text
hostInstanceType} -> Maybe Text
hostInstanceType) (\s :: UpdateBrokerResponse
s@UpdateBrokerResponse' {} Maybe Text
a -> UpdateBrokerResponse
s {$sel:hostInstanceType:UpdateBrokerResponse' :: Maybe Text
hostInstanceType = Maybe Text
a} :: UpdateBrokerResponse)

-- | Optional. The metadata of the LDAP server used to authenticate and
-- authorize connections to the broker. Does not apply to RabbitMQ brokers.
updateBrokerResponse_ldapServerMetadata :: Lens.Lens' UpdateBrokerResponse (Prelude.Maybe LdapServerMetadataOutput)
updateBrokerResponse_ldapServerMetadata :: Lens' UpdateBrokerResponse (Maybe LdapServerMetadataOutput)
updateBrokerResponse_ldapServerMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrokerResponse' {Maybe LdapServerMetadataOutput
ldapServerMetadata :: Maybe LdapServerMetadataOutput
$sel:ldapServerMetadata:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe LdapServerMetadataOutput
ldapServerMetadata} -> Maybe LdapServerMetadataOutput
ldapServerMetadata) (\s :: UpdateBrokerResponse
s@UpdateBrokerResponse' {} Maybe LdapServerMetadataOutput
a -> UpdateBrokerResponse
s {$sel:ldapServerMetadata:UpdateBrokerResponse' :: Maybe LdapServerMetadataOutput
ldapServerMetadata = Maybe LdapServerMetadataOutput
a} :: UpdateBrokerResponse)

-- | The list of information about logs to be enabled for the specified
-- broker.
updateBrokerResponse_logs :: Lens.Lens' UpdateBrokerResponse (Prelude.Maybe Logs)
updateBrokerResponse_logs :: Lens' UpdateBrokerResponse (Maybe Logs)
updateBrokerResponse_logs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrokerResponse' {Maybe Logs
logs :: Maybe Logs
$sel:logs:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe Logs
logs} -> Maybe Logs
logs) (\s :: UpdateBrokerResponse
s@UpdateBrokerResponse' {} Maybe Logs
a -> UpdateBrokerResponse
s {$sel:logs:UpdateBrokerResponse' :: Maybe Logs
logs = Maybe Logs
a} :: UpdateBrokerResponse)

-- | The parameters that determine the WeeklyStartTime.
updateBrokerResponse_maintenanceWindowStartTime :: Lens.Lens' UpdateBrokerResponse (Prelude.Maybe WeeklyStartTime)
updateBrokerResponse_maintenanceWindowStartTime :: Lens' UpdateBrokerResponse (Maybe WeeklyStartTime)
updateBrokerResponse_maintenanceWindowStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrokerResponse' {Maybe WeeklyStartTime
maintenanceWindowStartTime :: Maybe WeeklyStartTime
$sel:maintenanceWindowStartTime:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe WeeklyStartTime
maintenanceWindowStartTime} -> Maybe WeeklyStartTime
maintenanceWindowStartTime) (\s :: UpdateBrokerResponse
s@UpdateBrokerResponse' {} Maybe WeeklyStartTime
a -> UpdateBrokerResponse
s {$sel:maintenanceWindowStartTime:UpdateBrokerResponse' :: Maybe WeeklyStartTime
maintenanceWindowStartTime = Maybe WeeklyStartTime
a} :: UpdateBrokerResponse)

-- | The list of security groups (1 minimum, 5 maximum) that authorizes
-- connections to brokers.
updateBrokerResponse_securityGroups :: Lens.Lens' UpdateBrokerResponse (Prelude.Maybe [Prelude.Text])
updateBrokerResponse_securityGroups :: Lens' UpdateBrokerResponse (Maybe [Text])
updateBrokerResponse_securityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrokerResponse' {Maybe [Text]
securityGroups :: Maybe [Text]
$sel:securityGroups:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe [Text]
securityGroups} -> Maybe [Text]
securityGroups) (\s :: UpdateBrokerResponse
s@UpdateBrokerResponse' {} Maybe [Text]
a -> UpdateBrokerResponse
s {$sel:securityGroups:UpdateBrokerResponse' :: Maybe [Text]
securityGroups = Maybe [Text]
a} :: UpdateBrokerResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData UpdateBrokerResponse where
  rnf :: UpdateBrokerResponse -> ()
rnf UpdateBrokerResponse' {Int
Maybe Bool
Maybe [Text]
Maybe Text
Maybe AuthenticationStrategy
Maybe ConfigurationId
Maybe LdapServerMetadataOutput
Maybe Logs
Maybe WeeklyStartTime
httpStatus :: Int
securityGroups :: Maybe [Text]
maintenanceWindowStartTime :: Maybe WeeklyStartTime
logs :: Maybe Logs
ldapServerMetadata :: Maybe LdapServerMetadataOutput
hostInstanceType :: Maybe Text
engineVersion :: Maybe Text
configuration :: Maybe ConfigurationId
brokerId :: Maybe Text
autoMinorVersionUpgrade :: Maybe Bool
authenticationStrategy :: Maybe AuthenticationStrategy
$sel:httpStatus:UpdateBrokerResponse' :: UpdateBrokerResponse -> Int
$sel:securityGroups:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe [Text]
$sel:maintenanceWindowStartTime:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe WeeklyStartTime
$sel:logs:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe Logs
$sel:ldapServerMetadata:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe LdapServerMetadataOutput
$sel:hostInstanceType:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe Text
$sel:engineVersion:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe Text
$sel:configuration:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe ConfigurationId
$sel:brokerId:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe Text
$sel:autoMinorVersionUpgrade:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe Bool
$sel:authenticationStrategy:UpdateBrokerResponse' :: UpdateBrokerResponse -> Maybe AuthenticationStrategy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AuthenticationStrategy
authenticationStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoMinorVersionUpgrade
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
brokerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConfigurationId
configuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostInstanceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LdapServerMetadataOutput
ldapServerMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Logs
logs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WeeklyStartTime
maintenanceWindowStartTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
securityGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus