{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.DBProxy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.RDS.Types.DBProxy 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.DBProxyStatus
import Amazonka.RDS.Types.UserAuthConfigInfo

-- | The data structure representing a proxy managed by the RDS Proxy.
--
-- This data type is used as a response element in the @DescribeDBProxies@
-- action.
--
-- /See:/ 'newDBProxy' smart constructor.
data DBProxy = DBProxy'
  { -- | One or more data structures specifying the authorization mechanism to
    -- connect to the associated RDS DB instance or Aurora DB cluster.
    DBProxy -> Maybe [UserAuthConfigInfo]
auth :: Prelude.Maybe [UserAuthConfigInfo],
    -- | The date and time when the proxy was first created.
    DBProxy -> Maybe ISO8601
createdDate :: Prelude.Maybe Data.ISO8601,
    -- | The Amazon Resource Name (ARN) for the proxy.
    DBProxy -> Maybe Text
dbProxyArn :: Prelude.Maybe Prelude.Text,
    -- | The identifier for the proxy. This name must be unique for all proxies
    -- owned by your Amazon Web Services account in the specified Amazon Web
    -- Services Region.
    DBProxy -> Maybe Text
dbProxyName :: Prelude.Maybe Prelude.Text,
    -- | 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.
    DBProxy -> Maybe Bool
debugLogging :: Prelude.Maybe Prelude.Bool,
    -- | The endpoint that you can use to connect to the DB proxy. You include
    -- the endpoint value in the connection string for a database client
    -- application.
    DBProxy -> Maybe Text
endpoint :: Prelude.Maybe Prelude.Text,
    -- | The kinds of databases that the proxy can connect to. This value
    -- determines which database network protocol the proxy recognizes when it
    -- interprets network traffic to and from the database. @MYSQL@ supports
    -- Aurora MySQL, RDS for MariaDB, and RDS for MySQL databases. @POSTGRESQL@
    -- supports Aurora PostgreSQL and RDS for PostgreSQL databases. @SQLSERVER@
    -- supports RDS for Microsoft SQL Server databases.
    DBProxy -> Maybe Text
engineFamily :: Prelude.Maybe Prelude.Text,
    -- | The number of seconds a connection to the proxy can have no activity
    -- before the proxy drops the client connection. The proxy keeps the
    -- underlying database connection open and puts it back into the connection
    -- pool for reuse by later connection requests.
    --
    -- Default: 1800 (30 minutes)
    --
    -- Constraints: 1 to 28,800
    DBProxy -> Maybe Int
idleClientTimeout :: Prelude.Maybe Prelude.Int,
    -- | Indicates whether Transport Layer Security (TLS) encryption is required
    -- for connections to the proxy.
    DBProxy -> Maybe Bool
requireTLS :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) for the IAM role that the proxy uses to
    -- access Amazon Secrets Manager.
    DBProxy -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The current status of this proxy. A status of @available@ means the
    -- proxy is ready to handle requests. Other values indicate that you must
    -- wait for the proxy to be ready, or take some action to resolve an issue.
    DBProxy -> Maybe DBProxyStatus
status :: Prelude.Maybe DBProxyStatus,
    -- | The date and time when the proxy was last updated.
    DBProxy -> Maybe ISO8601
updatedDate :: Prelude.Maybe Data.ISO8601,
    -- | Provides the VPC ID of the DB proxy.
    DBProxy -> Maybe Text
vpcId :: Prelude.Maybe Prelude.Text,
    -- | Provides a list of VPC security groups that the proxy belongs to.
    DBProxy -> Maybe [Text]
vpcSecurityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The EC2 subnet IDs for the proxy.
    DBProxy -> Maybe [Text]
vpcSubnetIds :: Prelude.Maybe [Prelude.Text]
  }
  deriving (DBProxy -> DBProxy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DBProxy -> DBProxy -> Bool
$c/= :: DBProxy -> DBProxy -> Bool
== :: DBProxy -> DBProxy -> Bool
$c== :: DBProxy -> DBProxy -> Bool
Prelude.Eq, ReadPrec [DBProxy]
ReadPrec DBProxy
Int -> ReadS DBProxy
ReadS [DBProxy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DBProxy]
$creadListPrec :: ReadPrec [DBProxy]
readPrec :: ReadPrec DBProxy
$creadPrec :: ReadPrec DBProxy
readList :: ReadS [DBProxy]
$creadList :: ReadS [DBProxy]
readsPrec :: Int -> ReadS DBProxy
$creadsPrec :: Int -> ReadS DBProxy
Prelude.Read, Int -> DBProxy -> ShowS
[DBProxy] -> ShowS
DBProxy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DBProxy] -> ShowS
$cshowList :: [DBProxy] -> ShowS
show :: DBProxy -> String
$cshow :: DBProxy -> String
showsPrec :: Int -> DBProxy -> ShowS
$cshowsPrec :: Int -> DBProxy -> ShowS
Prelude.Show, forall x. Rep DBProxy x -> DBProxy
forall x. DBProxy -> Rep DBProxy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DBProxy x -> DBProxy
$cfrom :: forall x. DBProxy -> Rep DBProxy x
Prelude.Generic)

-- |
-- Create a value of 'DBProxy' 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', 'dbProxy_auth' - One or more data structures specifying the authorization mechanism to
-- connect to the associated RDS DB instance or Aurora DB cluster.
--
-- 'createdDate', 'dbProxy_createdDate' - The date and time when the proxy was first created.
--
-- 'dbProxyArn', 'dbProxy_dbProxyArn' - The Amazon Resource Name (ARN) for the proxy.
--
-- 'dbProxyName', 'dbProxy_dbProxyName' - The identifier for the proxy. This name must be unique for all proxies
-- owned by your Amazon Web Services account in the specified Amazon Web
-- Services Region.
--
-- 'debugLogging', 'dbProxy_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.
--
-- 'endpoint', 'dbProxy_endpoint' - The endpoint that you can use to connect to the DB proxy. You include
-- the endpoint value in the connection string for a database client
-- application.
--
-- 'engineFamily', 'dbProxy_engineFamily' - The kinds of databases that the proxy can connect to. This value
-- determines which database network protocol the proxy recognizes when it
-- interprets network traffic to and from the database. @MYSQL@ supports
-- Aurora MySQL, RDS for MariaDB, and RDS for MySQL databases. @POSTGRESQL@
-- supports Aurora PostgreSQL and RDS for PostgreSQL databases. @SQLSERVER@
-- supports RDS for Microsoft SQL Server databases.
--
-- 'idleClientTimeout', 'dbProxy_idleClientTimeout' - The number of seconds a connection to the proxy can have no activity
-- before the proxy drops the client connection. The proxy keeps the
-- underlying database connection open and puts it back into the connection
-- pool for reuse by later connection requests.
--
-- Default: 1800 (30 minutes)
--
-- Constraints: 1 to 28,800
--
-- 'requireTLS', 'dbProxy_requireTLS' - Indicates whether Transport Layer Security (TLS) encryption is required
-- for connections to the proxy.
--
-- 'roleArn', 'dbProxy_roleArn' - The Amazon Resource Name (ARN) for the IAM role that the proxy uses to
-- access Amazon Secrets Manager.
--
-- 'status', 'dbProxy_status' - The current status of this proxy. A status of @available@ means the
-- proxy is ready to handle requests. Other values indicate that you must
-- wait for the proxy to be ready, or take some action to resolve an issue.
--
-- 'updatedDate', 'dbProxy_updatedDate' - The date and time when the proxy was last updated.
--
-- 'vpcId', 'dbProxy_vpcId' - Provides the VPC ID of the DB proxy.
--
-- 'vpcSecurityGroupIds', 'dbProxy_vpcSecurityGroupIds' - Provides a list of VPC security groups that the proxy belongs to.
--
-- 'vpcSubnetIds', 'dbProxy_vpcSubnetIds' - The EC2 subnet IDs for the proxy.
newDBProxy ::
  DBProxy
newDBProxy :: DBProxy
newDBProxy =
  DBProxy'
    { $sel:auth:DBProxy' :: Maybe [UserAuthConfigInfo]
auth = forall a. Maybe a
Prelude.Nothing,
      $sel:createdDate:DBProxy' :: Maybe ISO8601
createdDate = forall a. Maybe a
Prelude.Nothing,
      $sel:dbProxyArn:DBProxy' :: Maybe Text
dbProxyArn = forall a. Maybe a
Prelude.Nothing,
      $sel:dbProxyName:DBProxy' :: Maybe Text
dbProxyName = forall a. Maybe a
Prelude.Nothing,
      $sel:debugLogging:DBProxy' :: Maybe Bool
debugLogging = forall a. Maybe a
Prelude.Nothing,
      $sel:endpoint:DBProxy' :: Maybe Text
endpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:engineFamily:DBProxy' :: Maybe Text
engineFamily = forall a. Maybe a
Prelude.Nothing,
      $sel:idleClientTimeout:DBProxy' :: Maybe Int
idleClientTimeout = forall a. Maybe a
Prelude.Nothing,
      $sel:requireTLS:DBProxy' :: Maybe Bool
requireTLS = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:DBProxy' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DBProxy' :: Maybe DBProxyStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:updatedDate:DBProxy' :: Maybe ISO8601
updatedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcId:DBProxy' :: Maybe Text
vpcId = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcSecurityGroupIds:DBProxy' :: Maybe [Text]
vpcSecurityGroupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcSubnetIds:DBProxy' :: Maybe [Text]
vpcSubnetIds = forall a. Maybe a
Prelude.Nothing
    }

-- | One or more data structures specifying the authorization mechanism to
-- connect to the associated RDS DB instance or Aurora DB cluster.
dbProxy_auth :: Lens.Lens' DBProxy (Prelude.Maybe [UserAuthConfigInfo])
dbProxy_auth :: Lens' DBProxy (Maybe [UserAuthConfigInfo])
dbProxy_auth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe [UserAuthConfigInfo]
auth :: Maybe [UserAuthConfigInfo]
$sel:auth:DBProxy' :: DBProxy -> Maybe [UserAuthConfigInfo]
auth} -> Maybe [UserAuthConfigInfo]
auth) (\s :: DBProxy
s@DBProxy' {} Maybe [UserAuthConfigInfo]
a -> DBProxy
s {$sel:auth:DBProxy' :: Maybe [UserAuthConfigInfo]
auth = Maybe [UserAuthConfigInfo]
a} :: DBProxy) 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 date and time when the proxy was first created.
dbProxy_createdDate :: Lens.Lens' DBProxy (Prelude.Maybe Prelude.UTCTime)
dbProxy_createdDate :: Lens' DBProxy (Maybe UTCTime)
dbProxy_createdDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe ISO8601
createdDate :: Maybe ISO8601
$sel:createdDate:DBProxy' :: DBProxy -> Maybe ISO8601
createdDate} -> Maybe ISO8601
createdDate) (\s :: DBProxy
s@DBProxy' {} Maybe ISO8601
a -> DBProxy
s {$sel:createdDate:DBProxy' :: Maybe ISO8601
createdDate = Maybe ISO8601
a} :: DBProxy) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The Amazon Resource Name (ARN) for the proxy.
dbProxy_dbProxyArn :: Lens.Lens' DBProxy (Prelude.Maybe Prelude.Text)
dbProxy_dbProxyArn :: Lens' DBProxy (Maybe Text)
dbProxy_dbProxyArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe Text
dbProxyArn :: Maybe Text
$sel:dbProxyArn:DBProxy' :: DBProxy -> Maybe Text
dbProxyArn} -> Maybe Text
dbProxyArn) (\s :: DBProxy
s@DBProxy' {} Maybe Text
a -> DBProxy
s {$sel:dbProxyArn:DBProxy' :: Maybe Text
dbProxyArn = Maybe Text
a} :: DBProxy)

-- | The identifier for the proxy. This name must be unique for all proxies
-- owned by your Amazon Web Services account in the specified Amazon Web
-- Services Region.
dbProxy_dbProxyName :: Lens.Lens' DBProxy (Prelude.Maybe Prelude.Text)
dbProxy_dbProxyName :: Lens' DBProxy (Maybe Text)
dbProxy_dbProxyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe Text
dbProxyName :: Maybe Text
$sel:dbProxyName:DBProxy' :: DBProxy -> Maybe Text
dbProxyName} -> Maybe Text
dbProxyName) (\s :: DBProxy
s@DBProxy' {} Maybe Text
a -> DBProxy
s {$sel:dbProxyName:DBProxy' :: Maybe Text
dbProxyName = Maybe Text
a} :: DBProxy)

-- | 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.
dbProxy_debugLogging :: Lens.Lens' DBProxy (Prelude.Maybe Prelude.Bool)
dbProxy_debugLogging :: Lens' DBProxy (Maybe Bool)
dbProxy_debugLogging = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe Bool
debugLogging :: Maybe Bool
$sel:debugLogging:DBProxy' :: DBProxy -> Maybe Bool
debugLogging} -> Maybe Bool
debugLogging) (\s :: DBProxy
s@DBProxy' {} Maybe Bool
a -> DBProxy
s {$sel:debugLogging:DBProxy' :: Maybe Bool
debugLogging = Maybe Bool
a} :: DBProxy)

-- | The endpoint that you can use to connect to the DB proxy. You include
-- the endpoint value in the connection string for a database client
-- application.
dbProxy_endpoint :: Lens.Lens' DBProxy (Prelude.Maybe Prelude.Text)
dbProxy_endpoint :: Lens' DBProxy (Maybe Text)
dbProxy_endpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe Text
endpoint :: Maybe Text
$sel:endpoint:DBProxy' :: DBProxy -> Maybe Text
endpoint} -> Maybe Text
endpoint) (\s :: DBProxy
s@DBProxy' {} Maybe Text
a -> DBProxy
s {$sel:endpoint:DBProxy' :: Maybe Text
endpoint = Maybe Text
a} :: DBProxy)

-- | The kinds of databases that the proxy can connect to. This value
-- determines which database network protocol the proxy recognizes when it
-- interprets network traffic to and from the database. @MYSQL@ supports
-- Aurora MySQL, RDS for MariaDB, and RDS for MySQL databases. @POSTGRESQL@
-- supports Aurora PostgreSQL and RDS for PostgreSQL databases. @SQLSERVER@
-- supports RDS for Microsoft SQL Server databases.
dbProxy_engineFamily :: Lens.Lens' DBProxy (Prelude.Maybe Prelude.Text)
dbProxy_engineFamily :: Lens' DBProxy (Maybe Text)
dbProxy_engineFamily = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe Text
engineFamily :: Maybe Text
$sel:engineFamily:DBProxy' :: DBProxy -> Maybe Text
engineFamily} -> Maybe Text
engineFamily) (\s :: DBProxy
s@DBProxy' {} Maybe Text
a -> DBProxy
s {$sel:engineFamily:DBProxy' :: Maybe Text
engineFamily = Maybe Text
a} :: DBProxy)

-- | The number of seconds a connection to the proxy can have no activity
-- before the proxy drops the client connection. The proxy keeps the
-- underlying database connection open and puts it back into the connection
-- pool for reuse by later connection requests.
--
-- Default: 1800 (30 minutes)
--
-- Constraints: 1 to 28,800
dbProxy_idleClientTimeout :: Lens.Lens' DBProxy (Prelude.Maybe Prelude.Int)
dbProxy_idleClientTimeout :: Lens' DBProxy (Maybe Int)
dbProxy_idleClientTimeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe Int
idleClientTimeout :: Maybe Int
$sel:idleClientTimeout:DBProxy' :: DBProxy -> Maybe Int
idleClientTimeout} -> Maybe Int
idleClientTimeout) (\s :: DBProxy
s@DBProxy' {} Maybe Int
a -> DBProxy
s {$sel:idleClientTimeout:DBProxy' :: Maybe Int
idleClientTimeout = Maybe Int
a} :: DBProxy)

-- | Indicates whether Transport Layer Security (TLS) encryption is required
-- for connections to the proxy.
dbProxy_requireTLS :: Lens.Lens' DBProxy (Prelude.Maybe Prelude.Bool)
dbProxy_requireTLS :: Lens' DBProxy (Maybe Bool)
dbProxy_requireTLS = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe Bool
requireTLS :: Maybe Bool
$sel:requireTLS:DBProxy' :: DBProxy -> Maybe Bool
requireTLS} -> Maybe Bool
requireTLS) (\s :: DBProxy
s@DBProxy' {} Maybe Bool
a -> DBProxy
s {$sel:requireTLS:DBProxy' :: Maybe Bool
requireTLS = Maybe Bool
a} :: DBProxy)

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

-- | The current status of this proxy. A status of @available@ means the
-- proxy is ready to handle requests. Other values indicate that you must
-- wait for the proxy to be ready, or take some action to resolve an issue.
dbProxy_status :: Lens.Lens' DBProxy (Prelude.Maybe DBProxyStatus)
dbProxy_status :: Lens' DBProxy (Maybe DBProxyStatus)
dbProxy_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe DBProxyStatus
status :: Maybe DBProxyStatus
$sel:status:DBProxy' :: DBProxy -> Maybe DBProxyStatus
status} -> Maybe DBProxyStatus
status) (\s :: DBProxy
s@DBProxy' {} Maybe DBProxyStatus
a -> DBProxy
s {$sel:status:DBProxy' :: Maybe DBProxyStatus
status = Maybe DBProxyStatus
a} :: DBProxy)

-- | The date and time when the proxy was last updated.
dbProxy_updatedDate :: Lens.Lens' DBProxy (Prelude.Maybe Prelude.UTCTime)
dbProxy_updatedDate :: Lens' DBProxy (Maybe UTCTime)
dbProxy_updatedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe ISO8601
updatedDate :: Maybe ISO8601
$sel:updatedDate:DBProxy' :: DBProxy -> Maybe ISO8601
updatedDate} -> Maybe ISO8601
updatedDate) (\s :: DBProxy
s@DBProxy' {} Maybe ISO8601
a -> DBProxy
s {$sel:updatedDate:DBProxy' :: Maybe ISO8601
updatedDate = Maybe ISO8601
a} :: DBProxy) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Provides the VPC ID of the DB proxy.
dbProxy_vpcId :: Lens.Lens' DBProxy (Prelude.Maybe Prelude.Text)
dbProxy_vpcId :: Lens' DBProxy (Maybe Text)
dbProxy_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe Text
vpcId :: Maybe Text
$sel:vpcId:DBProxy' :: DBProxy -> Maybe Text
vpcId} -> Maybe Text
vpcId) (\s :: DBProxy
s@DBProxy' {} Maybe Text
a -> DBProxy
s {$sel:vpcId:DBProxy' :: Maybe Text
vpcId = Maybe Text
a} :: DBProxy)

-- | Provides a list of VPC security groups that the proxy belongs to.
dbProxy_vpcSecurityGroupIds :: Lens.Lens' DBProxy (Prelude.Maybe [Prelude.Text])
dbProxy_vpcSecurityGroupIds :: Lens' DBProxy (Maybe [Text])
dbProxy_vpcSecurityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe [Text]
vpcSecurityGroupIds :: Maybe [Text]
$sel:vpcSecurityGroupIds:DBProxy' :: DBProxy -> Maybe [Text]
vpcSecurityGroupIds} -> Maybe [Text]
vpcSecurityGroupIds) (\s :: DBProxy
s@DBProxy' {} Maybe [Text]
a -> DBProxy
s {$sel:vpcSecurityGroupIds:DBProxy' :: Maybe [Text]
vpcSecurityGroupIds = Maybe [Text]
a} :: DBProxy) 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 EC2 subnet IDs for the proxy.
dbProxy_vpcSubnetIds :: Lens.Lens' DBProxy (Prelude.Maybe [Prelude.Text])
dbProxy_vpcSubnetIds :: Lens' DBProxy (Maybe [Text])
dbProxy_vpcSubnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBProxy' {Maybe [Text]
vpcSubnetIds :: Maybe [Text]
$sel:vpcSubnetIds:DBProxy' :: DBProxy -> Maybe [Text]
vpcSubnetIds} -> Maybe [Text]
vpcSubnetIds) (\s :: DBProxy
s@DBProxy' {} Maybe [Text]
a -> DBProxy
s {$sel:vpcSubnetIds:DBProxy' :: Maybe [Text]
vpcSubnetIds = Maybe [Text]
a} :: DBProxy) 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

instance Data.FromXML DBProxy where
  parseXML :: [Node] -> Either String DBProxy
parseXML [Node]
x =
    Maybe [UserAuthConfigInfo]
-> Maybe ISO8601
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe Text
-> Maybe DBProxyStatus
-> Maybe ISO8601
-> Maybe Text
-> Maybe [Text]
-> Maybe [Text]
-> DBProxy
DBProxy'
      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
"Auth"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"CreatedDate")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DBProxyArn")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DBProxyName")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DebugLogging")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Endpoint")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"EngineFamily")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"IdleClientTimeout")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"RequireTLS")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"RoleArn")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Status")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"UpdatedDate")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"VpcId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"VpcSecurityGroupIds"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"VpcSubnetIds"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                  )

instance Prelude.Hashable DBProxy where
  hashWithSalt :: Int -> DBProxy -> Int
hashWithSalt Int
_salt DBProxy' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [UserAuthConfigInfo]
Maybe Text
Maybe ISO8601
Maybe DBProxyStatus
vpcSubnetIds :: Maybe [Text]
vpcSecurityGroupIds :: Maybe [Text]
vpcId :: Maybe Text
updatedDate :: Maybe ISO8601
status :: Maybe DBProxyStatus
roleArn :: Maybe Text
requireTLS :: Maybe Bool
idleClientTimeout :: Maybe Int
engineFamily :: Maybe Text
endpoint :: Maybe Text
debugLogging :: Maybe Bool
dbProxyName :: Maybe Text
dbProxyArn :: Maybe Text
createdDate :: Maybe ISO8601
auth :: Maybe [UserAuthConfigInfo]
$sel:vpcSubnetIds:DBProxy' :: DBProxy -> Maybe [Text]
$sel:vpcSecurityGroupIds:DBProxy' :: DBProxy -> Maybe [Text]
$sel:vpcId:DBProxy' :: DBProxy -> Maybe Text
$sel:updatedDate:DBProxy' :: DBProxy -> Maybe ISO8601
$sel:status:DBProxy' :: DBProxy -> Maybe DBProxyStatus
$sel:roleArn:DBProxy' :: DBProxy -> Maybe Text
$sel:requireTLS:DBProxy' :: DBProxy -> Maybe Bool
$sel:idleClientTimeout:DBProxy' :: DBProxy -> Maybe Int
$sel:engineFamily:DBProxy' :: DBProxy -> Maybe Text
$sel:endpoint:DBProxy' :: DBProxy -> Maybe Text
$sel:debugLogging:DBProxy' :: DBProxy -> Maybe Bool
$sel:dbProxyName:DBProxy' :: DBProxy -> Maybe Text
$sel:dbProxyArn:DBProxy' :: DBProxy -> Maybe Text
$sel:createdDate:DBProxy' :: DBProxy -> Maybe ISO8601
$sel:auth:DBProxy' :: DBProxy -> Maybe [UserAuthConfigInfo]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [UserAuthConfigInfo]
auth
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
createdDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbProxyArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbProxyName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
debugLogging
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
endpoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineFamily
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
idleClientTimeout
      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 DBProxyStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
updatedDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vpcId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
vpcSecurityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
vpcSubnetIds

instance Prelude.NFData DBProxy where
  rnf :: DBProxy -> ()
rnf DBProxy' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [UserAuthConfigInfo]
Maybe Text
Maybe ISO8601
Maybe DBProxyStatus
vpcSubnetIds :: Maybe [Text]
vpcSecurityGroupIds :: Maybe [Text]
vpcId :: Maybe Text
updatedDate :: Maybe ISO8601
status :: Maybe DBProxyStatus
roleArn :: Maybe Text
requireTLS :: Maybe Bool
idleClientTimeout :: Maybe Int
engineFamily :: Maybe Text
endpoint :: Maybe Text
debugLogging :: Maybe Bool
dbProxyName :: Maybe Text
dbProxyArn :: Maybe Text
createdDate :: Maybe ISO8601
auth :: Maybe [UserAuthConfigInfo]
$sel:vpcSubnetIds:DBProxy' :: DBProxy -> Maybe [Text]
$sel:vpcSecurityGroupIds:DBProxy' :: DBProxy -> Maybe [Text]
$sel:vpcId:DBProxy' :: DBProxy -> Maybe Text
$sel:updatedDate:DBProxy' :: DBProxy -> Maybe ISO8601
$sel:status:DBProxy' :: DBProxy -> Maybe DBProxyStatus
$sel:roleArn:DBProxy' :: DBProxy -> Maybe Text
$sel:requireTLS:DBProxy' :: DBProxy -> Maybe Bool
$sel:idleClientTimeout:DBProxy' :: DBProxy -> Maybe Int
$sel:engineFamily:DBProxy' :: DBProxy -> Maybe Text
$sel:endpoint:DBProxy' :: DBProxy -> Maybe Text
$sel:debugLogging:DBProxy' :: DBProxy -> Maybe Bool
$sel:dbProxyName:DBProxy' :: DBProxy -> Maybe Text
$sel:dbProxyArn:DBProxy' :: DBProxy -> Maybe Text
$sel:createdDate:DBProxy' :: DBProxy -> Maybe ISO8601
$sel:auth:DBProxy' :: DBProxy -> Maybe [UserAuthConfigInfo]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [UserAuthConfigInfo]
auth
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
createdDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbProxyArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbProxyName
      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 Text
endpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineFamily
      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 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 DBProxyStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
updatedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vpcId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
vpcSecurityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
vpcSubnetIds