{-# 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.RDS.ModifyDBProxyTargetGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the properties of a @DBProxyTargetGroup@.
module Amazonka.RDS.ModifyDBProxyTargetGroup
  ( -- * Creating a Request
    ModifyDBProxyTargetGroup (..),
    newModifyDBProxyTargetGroup,

    -- * Request Lenses
    modifyDBProxyTargetGroup_connectionPoolConfig,
    modifyDBProxyTargetGroup_newName,
    modifyDBProxyTargetGroup_targetGroupName,
    modifyDBProxyTargetGroup_dbProxyName,

    -- * Destructuring the Response
    ModifyDBProxyTargetGroupResponse (..),
    newModifyDBProxyTargetGroupResponse,

    -- * Response Lenses
    modifyDBProxyTargetGroupResponse_dbProxyTargetGroup,
    modifyDBProxyTargetGroupResponse_httpStatus,
  )
where

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

-- | /See:/ 'newModifyDBProxyTargetGroup' smart constructor.
data ModifyDBProxyTargetGroup = ModifyDBProxyTargetGroup'
  { -- | The settings that determine the size and behavior of the connection pool
    -- for the target group.
    ModifyDBProxyTargetGroup -> Maybe ConnectionPoolConfiguration
connectionPoolConfig :: Prelude.Maybe ConnectionPoolConfiguration,
    -- | The new name for the modified @DBProxyTarget@. An identifier must begin
    -- with a letter and must contain only ASCII letters, digits, and hyphens;
    -- it can\'t end with a hyphen or contain two consecutive hyphens.
    ModifyDBProxyTargetGroup -> Maybe Text
newName' :: Prelude.Maybe Prelude.Text,
    -- | The name of the target group to modify.
    ModifyDBProxyTargetGroup -> Text
targetGroupName :: Prelude.Text,
    -- | The name of the proxy.
    ModifyDBProxyTargetGroup -> Text
dbProxyName :: Prelude.Text
  }
  deriving (ModifyDBProxyTargetGroup -> ModifyDBProxyTargetGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyDBProxyTargetGroup -> ModifyDBProxyTargetGroup -> Bool
$c/= :: ModifyDBProxyTargetGroup -> ModifyDBProxyTargetGroup -> Bool
== :: ModifyDBProxyTargetGroup -> ModifyDBProxyTargetGroup -> Bool
$c== :: ModifyDBProxyTargetGroup -> ModifyDBProxyTargetGroup -> Bool
Prelude.Eq, ReadPrec [ModifyDBProxyTargetGroup]
ReadPrec ModifyDBProxyTargetGroup
Int -> ReadS ModifyDBProxyTargetGroup
ReadS [ModifyDBProxyTargetGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyDBProxyTargetGroup]
$creadListPrec :: ReadPrec [ModifyDBProxyTargetGroup]
readPrec :: ReadPrec ModifyDBProxyTargetGroup
$creadPrec :: ReadPrec ModifyDBProxyTargetGroup
readList :: ReadS [ModifyDBProxyTargetGroup]
$creadList :: ReadS [ModifyDBProxyTargetGroup]
readsPrec :: Int -> ReadS ModifyDBProxyTargetGroup
$creadsPrec :: Int -> ReadS ModifyDBProxyTargetGroup
Prelude.Read, Int -> ModifyDBProxyTargetGroup -> ShowS
[ModifyDBProxyTargetGroup] -> ShowS
ModifyDBProxyTargetGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyDBProxyTargetGroup] -> ShowS
$cshowList :: [ModifyDBProxyTargetGroup] -> ShowS
show :: ModifyDBProxyTargetGroup -> String
$cshow :: ModifyDBProxyTargetGroup -> String
showsPrec :: Int -> ModifyDBProxyTargetGroup -> ShowS
$cshowsPrec :: Int -> ModifyDBProxyTargetGroup -> ShowS
Prelude.Show, forall x.
Rep ModifyDBProxyTargetGroup x -> ModifyDBProxyTargetGroup
forall x.
ModifyDBProxyTargetGroup -> Rep ModifyDBProxyTargetGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyDBProxyTargetGroup x -> ModifyDBProxyTargetGroup
$cfrom :: forall x.
ModifyDBProxyTargetGroup -> Rep ModifyDBProxyTargetGroup x
Prelude.Generic)

-- |
-- Create a value of 'ModifyDBProxyTargetGroup' 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:
--
-- 'connectionPoolConfig', 'modifyDBProxyTargetGroup_connectionPoolConfig' - The settings that determine the size and behavior of the connection pool
-- for the target group.
--
-- 'newName'', 'modifyDBProxyTargetGroup_newName' - The new name for the modified @DBProxyTarget@. An identifier must begin
-- with a letter and must contain only ASCII letters, digits, and hyphens;
-- it can\'t end with a hyphen or contain two consecutive hyphens.
--
-- 'targetGroupName', 'modifyDBProxyTargetGroup_targetGroupName' - The name of the target group to modify.
--
-- 'dbProxyName', 'modifyDBProxyTargetGroup_dbProxyName' - The name of the proxy.
newModifyDBProxyTargetGroup ::
  -- | 'targetGroupName'
  Prelude.Text ->
  -- | 'dbProxyName'
  Prelude.Text ->
  ModifyDBProxyTargetGroup
newModifyDBProxyTargetGroup :: Text -> Text -> ModifyDBProxyTargetGroup
newModifyDBProxyTargetGroup
  Text
pTargetGroupName_
  Text
pDBProxyName_ =
    ModifyDBProxyTargetGroup'
      { $sel:connectionPoolConfig:ModifyDBProxyTargetGroup' :: Maybe ConnectionPoolConfiguration
connectionPoolConfig =
          forall a. Maybe a
Prelude.Nothing,
        $sel:newName':ModifyDBProxyTargetGroup' :: Maybe Text
newName' = forall a. Maybe a
Prelude.Nothing,
        $sel:targetGroupName:ModifyDBProxyTargetGroup' :: Text
targetGroupName = Text
pTargetGroupName_,
        $sel:dbProxyName:ModifyDBProxyTargetGroup' :: Text
dbProxyName = Text
pDBProxyName_
      }

-- | The settings that determine the size and behavior of the connection pool
-- for the target group.
modifyDBProxyTargetGroup_connectionPoolConfig :: Lens.Lens' ModifyDBProxyTargetGroup (Prelude.Maybe ConnectionPoolConfiguration)
modifyDBProxyTargetGroup_connectionPoolConfig :: Lens' ModifyDBProxyTargetGroup (Maybe ConnectionPoolConfiguration)
modifyDBProxyTargetGroup_connectionPoolConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxyTargetGroup' {Maybe ConnectionPoolConfiguration
connectionPoolConfig :: Maybe ConnectionPoolConfiguration
$sel:connectionPoolConfig:ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Maybe ConnectionPoolConfiguration
connectionPoolConfig} -> Maybe ConnectionPoolConfiguration
connectionPoolConfig) (\s :: ModifyDBProxyTargetGroup
s@ModifyDBProxyTargetGroup' {} Maybe ConnectionPoolConfiguration
a -> ModifyDBProxyTargetGroup
s {$sel:connectionPoolConfig:ModifyDBProxyTargetGroup' :: Maybe ConnectionPoolConfiguration
connectionPoolConfig = Maybe ConnectionPoolConfiguration
a} :: ModifyDBProxyTargetGroup)

-- | The new name for the modified @DBProxyTarget@. An identifier must begin
-- with a letter and must contain only ASCII letters, digits, and hyphens;
-- it can\'t end with a hyphen or contain two consecutive hyphens.
modifyDBProxyTargetGroup_newName :: Lens.Lens' ModifyDBProxyTargetGroup (Prelude.Maybe Prelude.Text)
modifyDBProxyTargetGroup_newName :: Lens' ModifyDBProxyTargetGroup (Maybe Text)
modifyDBProxyTargetGroup_newName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxyTargetGroup' {Maybe Text
newName' :: Maybe Text
$sel:newName':ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Maybe Text
newName'} -> Maybe Text
newName') (\s :: ModifyDBProxyTargetGroup
s@ModifyDBProxyTargetGroup' {} Maybe Text
a -> ModifyDBProxyTargetGroup
s {$sel:newName':ModifyDBProxyTargetGroup' :: Maybe Text
newName' = Maybe Text
a} :: ModifyDBProxyTargetGroup)

-- | The name of the target group to modify.
modifyDBProxyTargetGroup_targetGroupName :: Lens.Lens' ModifyDBProxyTargetGroup Prelude.Text
modifyDBProxyTargetGroup_targetGroupName :: Lens' ModifyDBProxyTargetGroup Text
modifyDBProxyTargetGroup_targetGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxyTargetGroup' {Text
targetGroupName :: Text
$sel:targetGroupName:ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Text
targetGroupName} -> Text
targetGroupName) (\s :: ModifyDBProxyTargetGroup
s@ModifyDBProxyTargetGroup' {} Text
a -> ModifyDBProxyTargetGroup
s {$sel:targetGroupName:ModifyDBProxyTargetGroup' :: Text
targetGroupName = Text
a} :: ModifyDBProxyTargetGroup)

-- | The name of the proxy.
modifyDBProxyTargetGroup_dbProxyName :: Lens.Lens' ModifyDBProxyTargetGroup Prelude.Text
modifyDBProxyTargetGroup_dbProxyName :: Lens' ModifyDBProxyTargetGroup Text
modifyDBProxyTargetGroup_dbProxyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxyTargetGroup' {Text
dbProxyName :: Text
$sel:dbProxyName:ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Text
dbProxyName} -> Text
dbProxyName) (\s :: ModifyDBProxyTargetGroup
s@ModifyDBProxyTargetGroup' {} Text
a -> ModifyDBProxyTargetGroup
s {$sel:dbProxyName:ModifyDBProxyTargetGroup' :: Text
dbProxyName = Text
a} :: ModifyDBProxyTargetGroup)

instance Core.AWSRequest ModifyDBProxyTargetGroup where
  type
    AWSResponse ModifyDBProxyTargetGroup =
      ModifyDBProxyTargetGroupResponse
  request :: (Service -> Service)
-> ModifyDBProxyTargetGroup -> Request ModifyDBProxyTargetGroup
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ModifyDBProxyTargetGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyDBProxyTargetGroup)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"ModifyDBProxyTargetGroupResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBProxyTargetGroup -> Int -> ModifyDBProxyTargetGroupResponse
ModifyDBProxyTargetGroupResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DBProxyTargetGroup")
            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 ModifyDBProxyTargetGroup where
  hashWithSalt :: Int -> ModifyDBProxyTargetGroup -> Int
hashWithSalt Int
_salt ModifyDBProxyTargetGroup' {Maybe Text
Maybe ConnectionPoolConfiguration
Text
dbProxyName :: Text
targetGroupName :: Text
newName' :: Maybe Text
connectionPoolConfig :: Maybe ConnectionPoolConfiguration
$sel:dbProxyName:ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Text
$sel:targetGroupName:ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Text
$sel:newName':ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Maybe Text
$sel:connectionPoolConfig:ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Maybe ConnectionPoolConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConnectionPoolConfiguration
connectionPoolConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
newName'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbProxyName

instance Prelude.NFData ModifyDBProxyTargetGroup where
  rnf :: ModifyDBProxyTargetGroup -> ()
rnf ModifyDBProxyTargetGroup' {Maybe Text
Maybe ConnectionPoolConfiguration
Text
dbProxyName :: Text
targetGroupName :: Text
newName' :: Maybe Text
connectionPoolConfig :: Maybe ConnectionPoolConfiguration
$sel:dbProxyName:ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Text
$sel:targetGroupName:ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Text
$sel:newName':ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Maybe Text
$sel:connectionPoolConfig:ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Maybe ConnectionPoolConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ConnectionPoolConfiguration
connectionPoolConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
newName'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbProxyName

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

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

instance Data.ToQuery ModifyDBProxyTargetGroup where
  toQuery :: ModifyDBProxyTargetGroup -> QueryString
toQuery ModifyDBProxyTargetGroup' {Maybe Text
Maybe ConnectionPoolConfiguration
Text
dbProxyName :: Text
targetGroupName :: Text
newName' :: Maybe Text
connectionPoolConfig :: Maybe ConnectionPoolConfiguration
$sel:dbProxyName:ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Text
$sel:targetGroupName:ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Text
$sel:newName':ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Maybe Text
$sel:connectionPoolConfig:ModifyDBProxyTargetGroup' :: ModifyDBProxyTargetGroup -> Maybe ConnectionPoolConfiguration
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyDBProxyTargetGroup" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"ConnectionPoolConfig" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ConnectionPoolConfiguration
connectionPoolConfig,
        ByteString
"NewName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
newName',
        ByteString
"TargetGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
targetGroupName,
        ByteString
"DBProxyName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbProxyName
      ]

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

-- |
-- Create a value of 'ModifyDBProxyTargetGroupResponse' 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:
--
-- 'dbProxyTargetGroup', 'modifyDBProxyTargetGroupResponse_dbProxyTargetGroup' - The settings of the modified @DBProxyTarget@.
--
-- 'httpStatus', 'modifyDBProxyTargetGroupResponse_httpStatus' - The response's http status code.
newModifyDBProxyTargetGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyDBProxyTargetGroupResponse
newModifyDBProxyTargetGroupResponse :: Int -> ModifyDBProxyTargetGroupResponse
newModifyDBProxyTargetGroupResponse Int
pHttpStatus_ =
  ModifyDBProxyTargetGroupResponse'
    { $sel:dbProxyTargetGroup:ModifyDBProxyTargetGroupResponse' :: Maybe DBProxyTargetGroup
dbProxyTargetGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyDBProxyTargetGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The settings of the modified @DBProxyTarget@.
modifyDBProxyTargetGroupResponse_dbProxyTargetGroup :: Lens.Lens' ModifyDBProxyTargetGroupResponse (Prelude.Maybe DBProxyTargetGroup)
modifyDBProxyTargetGroupResponse_dbProxyTargetGroup :: Lens' ModifyDBProxyTargetGroupResponse (Maybe DBProxyTargetGroup)
modifyDBProxyTargetGroupResponse_dbProxyTargetGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxyTargetGroupResponse' {Maybe DBProxyTargetGroup
dbProxyTargetGroup :: Maybe DBProxyTargetGroup
$sel:dbProxyTargetGroup:ModifyDBProxyTargetGroupResponse' :: ModifyDBProxyTargetGroupResponse -> Maybe DBProxyTargetGroup
dbProxyTargetGroup} -> Maybe DBProxyTargetGroup
dbProxyTargetGroup) (\s :: ModifyDBProxyTargetGroupResponse
s@ModifyDBProxyTargetGroupResponse' {} Maybe DBProxyTargetGroup
a -> ModifyDBProxyTargetGroupResponse
s {$sel:dbProxyTargetGroup:ModifyDBProxyTargetGroupResponse' :: Maybe DBProxyTargetGroup
dbProxyTargetGroup = Maybe DBProxyTargetGroup
a} :: ModifyDBProxyTargetGroupResponse)

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

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