{-# 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.ModifyDBProxy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Changes the settings for an existing DB proxy.
module Amazonka.RDS.ModifyDBProxy
  ( -- * Creating a Request
    ModifyDBProxy (..),
    newModifyDBProxy,

    -- * Request Lenses
    modifyDBProxy_auth,
    modifyDBProxy_debugLogging,
    modifyDBProxy_idleClientTimeout,
    modifyDBProxy_newDBProxyName,
    modifyDBProxy_requireTLS,
    modifyDBProxy_roleArn,
    modifyDBProxy_securityGroups,
    modifyDBProxy_dbProxyName,

    -- * Destructuring the Response
    ModifyDBProxyResponse (..),
    newModifyDBProxyResponse,

    -- * Response Lenses
    modifyDBProxyResponse_dbProxy,
    modifyDBProxyResponse_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:/ 'newModifyDBProxy' smart constructor.
data ModifyDBProxy = ModifyDBProxy'
  { -- | The new authentication settings for the @DBProxy@.
    ModifyDBProxy -> Maybe [UserAuthConfig]
auth :: Prelude.Maybe [UserAuthConfig],
    -- | Whether the proxy includes detailed information about SQL statements in
    -- its logs. This information helps you to debug issues involving SQL
    -- behavior or the performance and scalability of the proxy connections.
    -- The debug information includes the text of SQL statements that you
    -- submit through the proxy. Thus, only enable this setting when needed for
    -- debugging, and only when you have security measures in place to
    -- safeguard any sensitive information that appears in the logs.
    ModifyDBProxy -> Maybe Bool
debugLogging :: Prelude.Maybe Prelude.Bool,
    -- | The number of seconds that a connection to the proxy can be inactive
    -- before the proxy disconnects it. You can set this value higher or lower
    -- than the connection timeout limit for the associated database.
    ModifyDBProxy -> Maybe Int
idleClientTimeout :: Prelude.Maybe Prelude.Int,
    -- | The new identifier for the @DBProxy@. 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.
    ModifyDBProxy -> Maybe Text
newDBProxyName' :: Prelude.Maybe Prelude.Text,
    -- | Whether Transport Layer Security (TLS) encryption is required for
    -- connections to the proxy. By enabling this setting, you can enforce
    -- encrypted TLS connections to the proxy, even if the associated database
    -- doesn\'t use TLS.
    ModifyDBProxy -> Maybe Bool
requireTLS :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) of the IAM role that the proxy uses to
    -- access secrets in Amazon Web Services Secrets Manager.
    ModifyDBProxy -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The new list of security groups for the @DBProxy@.
    ModifyDBProxy -> Maybe [Text]
securityGroups :: Prelude.Maybe [Prelude.Text],
    -- | The identifier for the @DBProxy@ to modify.
    ModifyDBProxy -> Text
dbProxyName :: Prelude.Text
  }
  deriving (ModifyDBProxy -> ModifyDBProxy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyDBProxy -> ModifyDBProxy -> Bool
$c/= :: ModifyDBProxy -> ModifyDBProxy -> Bool
== :: ModifyDBProxy -> ModifyDBProxy -> Bool
$c== :: ModifyDBProxy -> ModifyDBProxy -> Bool
Prelude.Eq, ReadPrec [ModifyDBProxy]
ReadPrec ModifyDBProxy
Int -> ReadS ModifyDBProxy
ReadS [ModifyDBProxy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyDBProxy]
$creadListPrec :: ReadPrec [ModifyDBProxy]
readPrec :: ReadPrec ModifyDBProxy
$creadPrec :: ReadPrec ModifyDBProxy
readList :: ReadS [ModifyDBProxy]
$creadList :: ReadS [ModifyDBProxy]
readsPrec :: Int -> ReadS ModifyDBProxy
$creadsPrec :: Int -> ReadS ModifyDBProxy
Prelude.Read, Int -> ModifyDBProxy -> ShowS
[ModifyDBProxy] -> ShowS
ModifyDBProxy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyDBProxy] -> ShowS
$cshowList :: [ModifyDBProxy] -> ShowS
show :: ModifyDBProxy -> String
$cshow :: ModifyDBProxy -> String
showsPrec :: Int -> ModifyDBProxy -> ShowS
$cshowsPrec :: Int -> ModifyDBProxy -> ShowS
Prelude.Show, forall x. Rep ModifyDBProxy x -> ModifyDBProxy
forall x. ModifyDBProxy -> Rep ModifyDBProxy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyDBProxy x -> ModifyDBProxy
$cfrom :: forall x. ModifyDBProxy -> Rep ModifyDBProxy x
Prelude.Generic)

-- |
-- Create a value of 'ModifyDBProxy' 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:
--
-- 'auth', 'modifyDBProxy_auth' - The new authentication settings for the @DBProxy@.
--
-- 'debugLogging', 'modifyDBProxy_debugLogging' - Whether the proxy includes detailed information about SQL statements in
-- its logs. This information helps you to debug issues involving SQL
-- behavior or the performance and scalability of the proxy connections.
-- The debug information includes the text of SQL statements that you
-- submit through the proxy. Thus, only enable this setting when needed for
-- debugging, and only when you have security measures in place to
-- safeguard any sensitive information that appears in the logs.
--
-- 'idleClientTimeout', 'modifyDBProxy_idleClientTimeout' - The number of seconds that a connection to the proxy can be inactive
-- before the proxy disconnects it. You can set this value higher or lower
-- than the connection timeout limit for the associated database.
--
-- 'newDBProxyName'', 'modifyDBProxy_newDBProxyName' - The new identifier for the @DBProxy@. 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.
--
-- 'requireTLS', 'modifyDBProxy_requireTLS' - Whether Transport Layer Security (TLS) encryption is required for
-- connections to the proxy. By enabling this setting, you can enforce
-- encrypted TLS connections to the proxy, even if the associated database
-- doesn\'t use TLS.
--
-- 'roleArn', 'modifyDBProxy_roleArn' - The Amazon Resource Name (ARN) of the IAM role that the proxy uses to
-- access secrets in Amazon Web Services Secrets Manager.
--
-- 'securityGroups', 'modifyDBProxy_securityGroups' - The new list of security groups for the @DBProxy@.
--
-- 'dbProxyName', 'modifyDBProxy_dbProxyName' - The identifier for the @DBProxy@ to modify.
newModifyDBProxy ::
  -- | 'dbProxyName'
  Prelude.Text ->
  ModifyDBProxy
newModifyDBProxy :: Text -> ModifyDBProxy
newModifyDBProxy Text
pDBProxyName_ =
  ModifyDBProxy'
    { $sel:auth:ModifyDBProxy' :: Maybe [UserAuthConfig]
auth = forall a. Maybe a
Prelude.Nothing,
      $sel:debugLogging:ModifyDBProxy' :: Maybe Bool
debugLogging = forall a. Maybe a
Prelude.Nothing,
      $sel:idleClientTimeout:ModifyDBProxy' :: Maybe Int
idleClientTimeout = forall a. Maybe a
Prelude.Nothing,
      $sel:newDBProxyName':ModifyDBProxy' :: Maybe Text
newDBProxyName' = forall a. Maybe a
Prelude.Nothing,
      $sel:requireTLS:ModifyDBProxy' :: Maybe Bool
requireTLS = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:ModifyDBProxy' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroups:ModifyDBProxy' :: Maybe [Text]
securityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:dbProxyName:ModifyDBProxy' :: Text
dbProxyName = Text
pDBProxyName_
    }

-- | The new authentication settings for the @DBProxy@.
modifyDBProxy_auth :: Lens.Lens' ModifyDBProxy (Prelude.Maybe [UserAuthConfig])
modifyDBProxy_auth :: Lens' ModifyDBProxy (Maybe [UserAuthConfig])
modifyDBProxy_auth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxy' {Maybe [UserAuthConfig]
auth :: Maybe [UserAuthConfig]
$sel:auth:ModifyDBProxy' :: ModifyDBProxy -> Maybe [UserAuthConfig]
auth} -> Maybe [UserAuthConfig]
auth) (\s :: ModifyDBProxy
s@ModifyDBProxy' {} Maybe [UserAuthConfig]
a -> ModifyDBProxy
s {$sel:auth:ModifyDBProxy' :: Maybe [UserAuthConfig]
auth = Maybe [UserAuthConfig]
a} :: ModifyDBProxy) 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

-- | Whether the proxy includes detailed information about SQL statements in
-- its logs. This information helps you to debug issues involving SQL
-- behavior or the performance and scalability of the proxy connections.
-- The debug information includes the text of SQL statements that you
-- submit through the proxy. Thus, only enable this setting when needed for
-- debugging, and only when you have security measures in place to
-- safeguard any sensitive information that appears in the logs.
modifyDBProxy_debugLogging :: Lens.Lens' ModifyDBProxy (Prelude.Maybe Prelude.Bool)
modifyDBProxy_debugLogging :: Lens' ModifyDBProxy (Maybe Bool)
modifyDBProxy_debugLogging = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxy' {Maybe Bool
debugLogging :: Maybe Bool
$sel:debugLogging:ModifyDBProxy' :: ModifyDBProxy -> Maybe Bool
debugLogging} -> Maybe Bool
debugLogging) (\s :: ModifyDBProxy
s@ModifyDBProxy' {} Maybe Bool
a -> ModifyDBProxy
s {$sel:debugLogging:ModifyDBProxy' :: Maybe Bool
debugLogging = Maybe Bool
a} :: ModifyDBProxy)

-- | The number of seconds that a connection to the proxy can be inactive
-- before the proxy disconnects it. You can set this value higher or lower
-- than the connection timeout limit for the associated database.
modifyDBProxy_idleClientTimeout :: Lens.Lens' ModifyDBProxy (Prelude.Maybe Prelude.Int)
modifyDBProxy_idleClientTimeout :: Lens' ModifyDBProxy (Maybe Int)
modifyDBProxy_idleClientTimeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxy' {Maybe Int
idleClientTimeout :: Maybe Int
$sel:idleClientTimeout:ModifyDBProxy' :: ModifyDBProxy -> Maybe Int
idleClientTimeout} -> Maybe Int
idleClientTimeout) (\s :: ModifyDBProxy
s@ModifyDBProxy' {} Maybe Int
a -> ModifyDBProxy
s {$sel:idleClientTimeout:ModifyDBProxy' :: Maybe Int
idleClientTimeout = Maybe Int
a} :: ModifyDBProxy)

-- | The new identifier for the @DBProxy@. 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.
modifyDBProxy_newDBProxyName :: Lens.Lens' ModifyDBProxy (Prelude.Maybe Prelude.Text)
modifyDBProxy_newDBProxyName :: Lens' ModifyDBProxy (Maybe Text)
modifyDBProxy_newDBProxyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxy' {Maybe Text
newDBProxyName' :: Maybe Text
$sel:newDBProxyName':ModifyDBProxy' :: ModifyDBProxy -> Maybe Text
newDBProxyName'} -> Maybe Text
newDBProxyName') (\s :: ModifyDBProxy
s@ModifyDBProxy' {} Maybe Text
a -> ModifyDBProxy
s {$sel:newDBProxyName':ModifyDBProxy' :: Maybe Text
newDBProxyName' = Maybe Text
a} :: ModifyDBProxy)

-- | Whether Transport Layer Security (TLS) encryption is required for
-- connections to the proxy. By enabling this setting, you can enforce
-- encrypted TLS connections to the proxy, even if the associated database
-- doesn\'t use TLS.
modifyDBProxy_requireTLS :: Lens.Lens' ModifyDBProxy (Prelude.Maybe Prelude.Bool)
modifyDBProxy_requireTLS :: Lens' ModifyDBProxy (Maybe Bool)
modifyDBProxy_requireTLS = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxy' {Maybe Bool
requireTLS :: Maybe Bool
$sel:requireTLS:ModifyDBProxy' :: ModifyDBProxy -> Maybe Bool
requireTLS} -> Maybe Bool
requireTLS) (\s :: ModifyDBProxy
s@ModifyDBProxy' {} Maybe Bool
a -> ModifyDBProxy
s {$sel:requireTLS:ModifyDBProxy' :: Maybe Bool
requireTLS = Maybe Bool
a} :: ModifyDBProxy)

-- | The Amazon Resource Name (ARN) of the IAM role that the proxy uses to
-- access secrets in Amazon Web Services Secrets Manager.
modifyDBProxy_roleArn :: Lens.Lens' ModifyDBProxy (Prelude.Maybe Prelude.Text)
modifyDBProxy_roleArn :: Lens' ModifyDBProxy (Maybe Text)
modifyDBProxy_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxy' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:ModifyDBProxy' :: ModifyDBProxy -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: ModifyDBProxy
s@ModifyDBProxy' {} Maybe Text
a -> ModifyDBProxy
s {$sel:roleArn:ModifyDBProxy' :: Maybe Text
roleArn = Maybe Text
a} :: ModifyDBProxy)

-- | The new list of security groups for the @DBProxy@.
modifyDBProxy_securityGroups :: Lens.Lens' ModifyDBProxy (Prelude.Maybe [Prelude.Text])
modifyDBProxy_securityGroups :: Lens' ModifyDBProxy (Maybe [Text])
modifyDBProxy_securityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxy' {Maybe [Text]
securityGroups :: Maybe [Text]
$sel:securityGroups:ModifyDBProxy' :: ModifyDBProxy -> Maybe [Text]
securityGroups} -> Maybe [Text]
securityGroups) (\s :: ModifyDBProxy
s@ModifyDBProxy' {} Maybe [Text]
a -> ModifyDBProxy
s {$sel:securityGroups:ModifyDBProxy' :: Maybe [Text]
securityGroups = Maybe [Text]
a} :: ModifyDBProxy) 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 identifier for the @DBProxy@ to modify.
modifyDBProxy_dbProxyName :: Lens.Lens' ModifyDBProxy Prelude.Text
modifyDBProxy_dbProxyName :: Lens' ModifyDBProxy Text
modifyDBProxy_dbProxyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxy' {Text
dbProxyName :: Text
$sel:dbProxyName:ModifyDBProxy' :: ModifyDBProxy -> Text
dbProxyName} -> Text
dbProxyName) (\s :: ModifyDBProxy
s@ModifyDBProxy' {} Text
a -> ModifyDBProxy
s {$sel:dbProxyName:ModifyDBProxy' :: Text
dbProxyName = Text
a} :: ModifyDBProxy)

instance Core.AWSRequest ModifyDBProxy where
  type
    AWSResponse ModifyDBProxy =
      ModifyDBProxyResponse
  request :: (Service -> Service) -> ModifyDBProxy -> Request ModifyDBProxy
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 ModifyDBProxy
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ModifyDBProxy)))
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
"ModifyDBProxyResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBProxy -> Int -> ModifyDBProxyResponse
ModifyDBProxyResponse'
            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
"DBProxy")
            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 ModifyDBProxy where
  hashWithSalt :: Int -> ModifyDBProxy -> Int
hashWithSalt Int
_salt ModifyDBProxy' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [UserAuthConfig]
Maybe Text
Text
dbProxyName :: Text
securityGroups :: Maybe [Text]
roleArn :: Maybe Text
requireTLS :: Maybe Bool
newDBProxyName' :: Maybe Text
idleClientTimeout :: Maybe Int
debugLogging :: Maybe Bool
auth :: Maybe [UserAuthConfig]
$sel:dbProxyName:ModifyDBProxy' :: ModifyDBProxy -> Text
$sel:securityGroups:ModifyDBProxy' :: ModifyDBProxy -> Maybe [Text]
$sel:roleArn:ModifyDBProxy' :: ModifyDBProxy -> Maybe Text
$sel:requireTLS:ModifyDBProxy' :: ModifyDBProxy -> Maybe Bool
$sel:newDBProxyName':ModifyDBProxy' :: ModifyDBProxy -> Maybe Text
$sel:idleClientTimeout:ModifyDBProxy' :: ModifyDBProxy -> Maybe Int
$sel:debugLogging:ModifyDBProxy' :: ModifyDBProxy -> Maybe Bool
$sel:auth:ModifyDBProxy' :: ModifyDBProxy -> Maybe [UserAuthConfig]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [UserAuthConfig]
auth
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
debugLogging
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
idleClientTimeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
newDBProxyName'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
requireTLS
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbProxyName

instance Prelude.NFData ModifyDBProxy where
  rnf :: ModifyDBProxy -> ()
rnf ModifyDBProxy' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [UserAuthConfig]
Maybe Text
Text
dbProxyName :: Text
securityGroups :: Maybe [Text]
roleArn :: Maybe Text
requireTLS :: Maybe Bool
newDBProxyName' :: Maybe Text
idleClientTimeout :: Maybe Int
debugLogging :: Maybe Bool
auth :: Maybe [UserAuthConfig]
$sel:dbProxyName:ModifyDBProxy' :: ModifyDBProxy -> Text
$sel:securityGroups:ModifyDBProxy' :: ModifyDBProxy -> Maybe [Text]
$sel:roleArn:ModifyDBProxy' :: ModifyDBProxy -> Maybe Text
$sel:requireTLS:ModifyDBProxy' :: ModifyDBProxy -> Maybe Bool
$sel:newDBProxyName':ModifyDBProxy' :: ModifyDBProxy -> Maybe Text
$sel:idleClientTimeout:ModifyDBProxy' :: ModifyDBProxy -> Maybe Int
$sel:debugLogging:ModifyDBProxy' :: ModifyDBProxy -> Maybe Bool
$sel:auth:ModifyDBProxy' :: ModifyDBProxy -> Maybe [UserAuthConfig]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [UserAuthConfig]
auth
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
debugLogging
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
idleClientTimeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
newDBProxyName'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
requireTLS
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      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
dbProxyName

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

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

instance Data.ToQuery ModifyDBProxy where
  toQuery :: ModifyDBProxy -> QueryString
toQuery ModifyDBProxy' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [UserAuthConfig]
Maybe Text
Text
dbProxyName :: Text
securityGroups :: Maybe [Text]
roleArn :: Maybe Text
requireTLS :: Maybe Bool
newDBProxyName' :: Maybe Text
idleClientTimeout :: Maybe Int
debugLogging :: Maybe Bool
auth :: Maybe [UserAuthConfig]
$sel:dbProxyName:ModifyDBProxy' :: ModifyDBProxy -> Text
$sel:securityGroups:ModifyDBProxy' :: ModifyDBProxy -> Maybe [Text]
$sel:roleArn:ModifyDBProxy' :: ModifyDBProxy -> Maybe Text
$sel:requireTLS:ModifyDBProxy' :: ModifyDBProxy -> Maybe Bool
$sel:newDBProxyName':ModifyDBProxy' :: ModifyDBProxy -> Maybe Text
$sel:idleClientTimeout:ModifyDBProxy' :: ModifyDBProxy -> Maybe Int
$sel:debugLogging:ModifyDBProxy' :: ModifyDBProxy -> Maybe Bool
$sel:auth:ModifyDBProxy' :: ModifyDBProxy -> Maybe [UserAuthConfig]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyDBProxy" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"Auth"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [UserAuthConfig]
auth),
        ByteString
"DebugLogging" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
debugLogging,
        ByteString
"IdleClientTimeout" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
idleClientTimeout,
        ByteString
"NewDBProxyName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
newDBProxyName',
        ByteString
"RequireTLS" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
requireTLS,
        ByteString
"RoleArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
roleArn,
        ByteString
"SecurityGroups"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
securityGroups
            ),
        ByteString
"DBProxyName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbProxyName
      ]

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

-- |
-- Create a value of 'ModifyDBProxyResponse' 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:
--
-- 'dbProxy', 'modifyDBProxyResponse_dbProxy' - The @DBProxy@ object representing the new settings for the proxy.
--
-- 'httpStatus', 'modifyDBProxyResponse_httpStatus' - The response's http status code.
newModifyDBProxyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyDBProxyResponse
newModifyDBProxyResponse :: Int -> ModifyDBProxyResponse
newModifyDBProxyResponse Int
pHttpStatus_ =
  ModifyDBProxyResponse'
    { $sel:dbProxy:ModifyDBProxyResponse' :: Maybe DBProxy
dbProxy = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyDBProxyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The @DBProxy@ object representing the new settings for the proxy.
modifyDBProxyResponse_dbProxy :: Lens.Lens' ModifyDBProxyResponse (Prelude.Maybe DBProxy)
modifyDBProxyResponse_dbProxy :: Lens' ModifyDBProxyResponse (Maybe DBProxy)
modifyDBProxyResponse_dbProxy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBProxyResponse' {Maybe DBProxy
dbProxy :: Maybe DBProxy
$sel:dbProxy:ModifyDBProxyResponse' :: ModifyDBProxyResponse -> Maybe DBProxy
dbProxy} -> Maybe DBProxy
dbProxy) (\s :: ModifyDBProxyResponse
s@ModifyDBProxyResponse' {} Maybe DBProxy
a -> ModifyDBProxyResponse
s {$sel:dbProxy:ModifyDBProxyResponse' :: Maybe DBProxy
dbProxy = Maybe DBProxy
a} :: ModifyDBProxyResponse)

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

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