{-# 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.CreateDBProxyEndpoint
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a @DBProxyEndpoint@. Only applies to proxies that are associated
-- with Aurora DB clusters. You can use DB proxy endpoints to specify
-- read\/write or read-only access to the DB cluster. You can also use DB
-- proxy endpoints to access a DB proxy through a different VPC than the
-- proxy\'s default VPC.
module Amazonka.RDS.CreateDBProxyEndpoint
  ( -- * Creating a Request
    CreateDBProxyEndpoint (..),
    newCreateDBProxyEndpoint,

    -- * Request Lenses
    createDBProxyEndpoint_tags,
    createDBProxyEndpoint_targetRole,
    createDBProxyEndpoint_vpcSecurityGroupIds,
    createDBProxyEndpoint_dbProxyName,
    createDBProxyEndpoint_dbProxyEndpointName,
    createDBProxyEndpoint_vpcSubnetIds,

    -- * Destructuring the Response
    CreateDBProxyEndpointResponse (..),
    newCreateDBProxyEndpointResponse,

    -- * Response Lenses
    createDBProxyEndpointResponse_dbProxyEndpoint,
    createDBProxyEndpointResponse_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:/ 'newCreateDBProxyEndpoint' smart constructor.
data CreateDBProxyEndpoint = CreateDBProxyEndpoint'
  { CreateDBProxyEndpoint -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A value that indicates whether the DB proxy endpoint can be used for
    -- read\/write or read-only operations. The default is @READ_WRITE@. The
    -- only role that proxies for RDS for Microsoft SQL Server support is
    -- @READ_WRITE@.
    CreateDBProxyEndpoint -> Maybe DBProxyEndpointTargetRole
targetRole :: Prelude.Maybe DBProxyEndpointTargetRole,
    -- | The VPC security group IDs for the DB proxy endpoint that you create.
    -- You can specify a different set of security group IDs than for the
    -- original DB proxy. The default is the default security group for the
    -- VPC.
    CreateDBProxyEndpoint -> Maybe [Text]
vpcSecurityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The name of the DB proxy associated with the DB proxy endpoint that you
    -- create.
    CreateDBProxyEndpoint -> Text
dbProxyName :: Prelude.Text,
    -- | The name of the DB proxy endpoint to create.
    CreateDBProxyEndpoint -> Text
dbProxyEndpointName :: Prelude.Text,
    -- | The VPC subnet IDs for the DB proxy endpoint that you create. You can
    -- specify a different set of subnet IDs than for the original DB proxy.
    CreateDBProxyEndpoint -> [Text]
vpcSubnetIds :: [Prelude.Text]
  }
  deriving (CreateDBProxyEndpoint -> CreateDBProxyEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDBProxyEndpoint -> CreateDBProxyEndpoint -> Bool
$c/= :: CreateDBProxyEndpoint -> CreateDBProxyEndpoint -> Bool
== :: CreateDBProxyEndpoint -> CreateDBProxyEndpoint -> Bool
$c== :: CreateDBProxyEndpoint -> CreateDBProxyEndpoint -> Bool
Prelude.Eq, ReadPrec [CreateDBProxyEndpoint]
ReadPrec CreateDBProxyEndpoint
Int -> ReadS CreateDBProxyEndpoint
ReadS [CreateDBProxyEndpoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDBProxyEndpoint]
$creadListPrec :: ReadPrec [CreateDBProxyEndpoint]
readPrec :: ReadPrec CreateDBProxyEndpoint
$creadPrec :: ReadPrec CreateDBProxyEndpoint
readList :: ReadS [CreateDBProxyEndpoint]
$creadList :: ReadS [CreateDBProxyEndpoint]
readsPrec :: Int -> ReadS CreateDBProxyEndpoint
$creadsPrec :: Int -> ReadS CreateDBProxyEndpoint
Prelude.Read, Int -> CreateDBProxyEndpoint -> ShowS
[CreateDBProxyEndpoint] -> ShowS
CreateDBProxyEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDBProxyEndpoint] -> ShowS
$cshowList :: [CreateDBProxyEndpoint] -> ShowS
show :: CreateDBProxyEndpoint -> String
$cshow :: CreateDBProxyEndpoint -> String
showsPrec :: Int -> CreateDBProxyEndpoint -> ShowS
$cshowsPrec :: Int -> CreateDBProxyEndpoint -> ShowS
Prelude.Show, forall x. Rep CreateDBProxyEndpoint x -> CreateDBProxyEndpoint
forall x. CreateDBProxyEndpoint -> Rep CreateDBProxyEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDBProxyEndpoint x -> CreateDBProxyEndpoint
$cfrom :: forall x. CreateDBProxyEndpoint -> Rep CreateDBProxyEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'CreateDBProxyEndpoint' 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:
--
-- 'tags', 'createDBProxyEndpoint_tags' - Undocumented member.
--
-- 'targetRole', 'createDBProxyEndpoint_targetRole' - A value that indicates whether the DB proxy endpoint can be used for
-- read\/write or read-only operations. The default is @READ_WRITE@. The
-- only role that proxies for RDS for Microsoft SQL Server support is
-- @READ_WRITE@.
--
-- 'vpcSecurityGroupIds', 'createDBProxyEndpoint_vpcSecurityGroupIds' - The VPC security group IDs for the DB proxy endpoint that you create.
-- You can specify a different set of security group IDs than for the
-- original DB proxy. The default is the default security group for the
-- VPC.
--
-- 'dbProxyName', 'createDBProxyEndpoint_dbProxyName' - The name of the DB proxy associated with the DB proxy endpoint that you
-- create.
--
-- 'dbProxyEndpointName', 'createDBProxyEndpoint_dbProxyEndpointName' - The name of the DB proxy endpoint to create.
--
-- 'vpcSubnetIds', 'createDBProxyEndpoint_vpcSubnetIds' - The VPC subnet IDs for the DB proxy endpoint that you create. You can
-- specify a different set of subnet IDs than for the original DB proxy.
newCreateDBProxyEndpoint ::
  -- | 'dbProxyName'
  Prelude.Text ->
  -- | 'dbProxyEndpointName'
  Prelude.Text ->
  CreateDBProxyEndpoint
newCreateDBProxyEndpoint :: Text -> Text -> CreateDBProxyEndpoint
newCreateDBProxyEndpoint
  Text
pDBProxyName_
  Text
pDBProxyEndpointName_ =
    CreateDBProxyEndpoint'
      { $sel:tags:CreateDBProxyEndpoint' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:targetRole:CreateDBProxyEndpoint' :: Maybe DBProxyEndpointTargetRole
targetRole = forall a. Maybe a
Prelude.Nothing,
        $sel:vpcSecurityGroupIds:CreateDBProxyEndpoint' :: Maybe [Text]
vpcSecurityGroupIds = forall a. Maybe a
Prelude.Nothing,
        $sel:dbProxyName:CreateDBProxyEndpoint' :: Text
dbProxyName = Text
pDBProxyName_,
        $sel:dbProxyEndpointName:CreateDBProxyEndpoint' :: Text
dbProxyEndpointName = Text
pDBProxyEndpointName_,
        $sel:vpcSubnetIds:CreateDBProxyEndpoint' :: [Text]
vpcSubnetIds = forall a. Monoid a => a
Prelude.mempty
      }

-- | Undocumented member.
createDBProxyEndpoint_tags :: Lens.Lens' CreateDBProxyEndpoint (Prelude.Maybe [Tag])
createDBProxyEndpoint_tags :: Lens' CreateDBProxyEndpoint (Maybe [Tag])
createDBProxyEndpoint_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBProxyEndpoint' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDBProxyEndpoint
s@CreateDBProxyEndpoint' {} Maybe [Tag]
a -> CreateDBProxyEndpoint
s {$sel:tags:CreateDBProxyEndpoint' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDBProxyEndpoint) 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

-- | A value that indicates whether the DB proxy endpoint can be used for
-- read\/write or read-only operations. The default is @READ_WRITE@. The
-- only role that proxies for RDS for Microsoft SQL Server support is
-- @READ_WRITE@.
createDBProxyEndpoint_targetRole :: Lens.Lens' CreateDBProxyEndpoint (Prelude.Maybe DBProxyEndpointTargetRole)
createDBProxyEndpoint_targetRole :: Lens' CreateDBProxyEndpoint (Maybe DBProxyEndpointTargetRole)
createDBProxyEndpoint_targetRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBProxyEndpoint' {Maybe DBProxyEndpointTargetRole
targetRole :: Maybe DBProxyEndpointTargetRole
$sel:targetRole:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Maybe DBProxyEndpointTargetRole
targetRole} -> Maybe DBProxyEndpointTargetRole
targetRole) (\s :: CreateDBProxyEndpoint
s@CreateDBProxyEndpoint' {} Maybe DBProxyEndpointTargetRole
a -> CreateDBProxyEndpoint
s {$sel:targetRole:CreateDBProxyEndpoint' :: Maybe DBProxyEndpointTargetRole
targetRole = Maybe DBProxyEndpointTargetRole
a} :: CreateDBProxyEndpoint)

-- | The VPC security group IDs for the DB proxy endpoint that you create.
-- You can specify a different set of security group IDs than for the
-- original DB proxy. The default is the default security group for the
-- VPC.
createDBProxyEndpoint_vpcSecurityGroupIds :: Lens.Lens' CreateDBProxyEndpoint (Prelude.Maybe [Prelude.Text])
createDBProxyEndpoint_vpcSecurityGroupIds :: Lens' CreateDBProxyEndpoint (Maybe [Text])
createDBProxyEndpoint_vpcSecurityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBProxyEndpoint' {Maybe [Text]
vpcSecurityGroupIds :: Maybe [Text]
$sel:vpcSecurityGroupIds:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Maybe [Text]
vpcSecurityGroupIds} -> Maybe [Text]
vpcSecurityGroupIds) (\s :: CreateDBProxyEndpoint
s@CreateDBProxyEndpoint' {} Maybe [Text]
a -> CreateDBProxyEndpoint
s {$sel:vpcSecurityGroupIds:CreateDBProxyEndpoint' :: Maybe [Text]
vpcSecurityGroupIds = Maybe [Text]
a} :: CreateDBProxyEndpoint) 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 name of the DB proxy associated with the DB proxy endpoint that you
-- create.
createDBProxyEndpoint_dbProxyName :: Lens.Lens' CreateDBProxyEndpoint Prelude.Text
createDBProxyEndpoint_dbProxyName :: Lens' CreateDBProxyEndpoint Text
createDBProxyEndpoint_dbProxyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBProxyEndpoint' {Text
dbProxyName :: Text
$sel:dbProxyName:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Text
dbProxyName} -> Text
dbProxyName) (\s :: CreateDBProxyEndpoint
s@CreateDBProxyEndpoint' {} Text
a -> CreateDBProxyEndpoint
s {$sel:dbProxyName:CreateDBProxyEndpoint' :: Text
dbProxyName = Text
a} :: CreateDBProxyEndpoint)

-- | The name of the DB proxy endpoint to create.
createDBProxyEndpoint_dbProxyEndpointName :: Lens.Lens' CreateDBProxyEndpoint Prelude.Text
createDBProxyEndpoint_dbProxyEndpointName :: Lens' CreateDBProxyEndpoint Text
createDBProxyEndpoint_dbProxyEndpointName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBProxyEndpoint' {Text
dbProxyEndpointName :: Text
$sel:dbProxyEndpointName:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Text
dbProxyEndpointName} -> Text
dbProxyEndpointName) (\s :: CreateDBProxyEndpoint
s@CreateDBProxyEndpoint' {} Text
a -> CreateDBProxyEndpoint
s {$sel:dbProxyEndpointName:CreateDBProxyEndpoint' :: Text
dbProxyEndpointName = Text
a} :: CreateDBProxyEndpoint)

-- | The VPC subnet IDs for the DB proxy endpoint that you create. You can
-- specify a different set of subnet IDs than for the original DB proxy.
createDBProxyEndpoint_vpcSubnetIds :: Lens.Lens' CreateDBProxyEndpoint [Prelude.Text]
createDBProxyEndpoint_vpcSubnetIds :: Lens' CreateDBProxyEndpoint [Text]
createDBProxyEndpoint_vpcSubnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBProxyEndpoint' {[Text]
vpcSubnetIds :: [Text]
$sel:vpcSubnetIds:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> [Text]
vpcSubnetIds} -> [Text]
vpcSubnetIds) (\s :: CreateDBProxyEndpoint
s@CreateDBProxyEndpoint' {} [Text]
a -> CreateDBProxyEndpoint
s {$sel:vpcSubnetIds:CreateDBProxyEndpoint' :: [Text]
vpcSubnetIds = [Text]
a} :: CreateDBProxyEndpoint) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateDBProxyEndpoint where
  type
    AWSResponse CreateDBProxyEndpoint =
      CreateDBProxyEndpointResponse
  request :: (Service -> Service)
-> CreateDBProxyEndpoint -> Request CreateDBProxyEndpoint
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 CreateDBProxyEndpoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDBProxyEndpoint)))
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
"CreateDBProxyEndpointResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBProxyEndpoint -> Int -> CreateDBProxyEndpointResponse
CreateDBProxyEndpointResponse'
            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
"DBProxyEndpoint")
            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 CreateDBProxyEndpoint where
  hashWithSalt :: Int -> CreateDBProxyEndpoint -> Int
hashWithSalt Int
_salt CreateDBProxyEndpoint' {[Text]
Maybe [Text]
Maybe [Tag]
Maybe DBProxyEndpointTargetRole
Text
vpcSubnetIds :: [Text]
dbProxyEndpointName :: Text
dbProxyName :: Text
vpcSecurityGroupIds :: Maybe [Text]
targetRole :: Maybe DBProxyEndpointTargetRole
tags :: Maybe [Tag]
$sel:vpcSubnetIds:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> [Text]
$sel:dbProxyEndpointName:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Text
$sel:dbProxyName:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Text
$sel:vpcSecurityGroupIds:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Maybe [Text]
$sel:targetRole:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Maybe DBProxyEndpointTargetRole
$sel:tags:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DBProxyEndpointTargetRole
targetRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
vpcSecurityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbProxyName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbProxyEndpointName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
vpcSubnetIds

instance Prelude.NFData CreateDBProxyEndpoint where
  rnf :: CreateDBProxyEndpoint -> ()
rnf CreateDBProxyEndpoint' {[Text]
Maybe [Text]
Maybe [Tag]
Maybe DBProxyEndpointTargetRole
Text
vpcSubnetIds :: [Text]
dbProxyEndpointName :: Text
dbProxyName :: Text
vpcSecurityGroupIds :: Maybe [Text]
targetRole :: Maybe DBProxyEndpointTargetRole
tags :: Maybe [Tag]
$sel:vpcSubnetIds:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> [Text]
$sel:dbProxyEndpointName:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Text
$sel:dbProxyName:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Text
$sel:vpcSecurityGroupIds:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Maybe [Text]
$sel:targetRole:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Maybe DBProxyEndpointTargetRole
$sel:tags:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DBProxyEndpointTargetRole
targetRole
      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 Text
dbProxyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbProxyEndpointName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
vpcSubnetIds

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

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

instance Data.ToQuery CreateDBProxyEndpoint where
  toQuery :: CreateDBProxyEndpoint -> QueryString
toQuery CreateDBProxyEndpoint' {[Text]
Maybe [Text]
Maybe [Tag]
Maybe DBProxyEndpointTargetRole
Text
vpcSubnetIds :: [Text]
dbProxyEndpointName :: Text
dbProxyName :: Text
vpcSecurityGroupIds :: Maybe [Text]
targetRole :: Maybe DBProxyEndpointTargetRole
tags :: Maybe [Tag]
$sel:vpcSubnetIds:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> [Text]
$sel:dbProxyEndpointName:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Text
$sel:dbProxyName:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Text
$sel:vpcSecurityGroupIds:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Maybe [Text]
$sel:targetRole:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Maybe DBProxyEndpointTargetRole
$sel:tags:CreateDBProxyEndpoint' :: CreateDBProxyEndpoint -> Maybe [Tag]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateDBProxyEndpoint" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"Tags"
          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
"Tag" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"TargetRole" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe DBProxyEndpointTargetRole
targetRole,
        ByteString
"VpcSecurityGroupIds"
          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]
vpcSecurityGroupIds
            ),
        ByteString
"DBProxyName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbProxyName,
        ByteString
"DBProxyEndpointName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbProxyEndpointName,
        ByteString
"VpcSubnetIds"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [Text]
vpcSubnetIds
      ]

-- | /See:/ 'newCreateDBProxyEndpointResponse' smart constructor.
data CreateDBProxyEndpointResponse = CreateDBProxyEndpointResponse'
  { -- | The @DBProxyEndpoint@ object that is created by the API operation. The
    -- DB proxy endpoint that you create might provide capabilities such as
    -- read\/write or read-only operations, or using a different VPC than the
    -- proxy\'s default VPC.
    CreateDBProxyEndpointResponse -> Maybe DBProxyEndpoint
dbProxyEndpoint :: Prelude.Maybe DBProxyEndpoint,
    -- | The response's http status code.
    CreateDBProxyEndpointResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDBProxyEndpointResponse
-> CreateDBProxyEndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDBProxyEndpointResponse
-> CreateDBProxyEndpointResponse -> Bool
$c/= :: CreateDBProxyEndpointResponse
-> CreateDBProxyEndpointResponse -> Bool
== :: CreateDBProxyEndpointResponse
-> CreateDBProxyEndpointResponse -> Bool
$c== :: CreateDBProxyEndpointResponse
-> CreateDBProxyEndpointResponse -> Bool
Prelude.Eq, ReadPrec [CreateDBProxyEndpointResponse]
ReadPrec CreateDBProxyEndpointResponse
Int -> ReadS CreateDBProxyEndpointResponse
ReadS [CreateDBProxyEndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDBProxyEndpointResponse]
$creadListPrec :: ReadPrec [CreateDBProxyEndpointResponse]
readPrec :: ReadPrec CreateDBProxyEndpointResponse
$creadPrec :: ReadPrec CreateDBProxyEndpointResponse
readList :: ReadS [CreateDBProxyEndpointResponse]
$creadList :: ReadS [CreateDBProxyEndpointResponse]
readsPrec :: Int -> ReadS CreateDBProxyEndpointResponse
$creadsPrec :: Int -> ReadS CreateDBProxyEndpointResponse
Prelude.Read, Int -> CreateDBProxyEndpointResponse -> ShowS
[CreateDBProxyEndpointResponse] -> ShowS
CreateDBProxyEndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDBProxyEndpointResponse] -> ShowS
$cshowList :: [CreateDBProxyEndpointResponse] -> ShowS
show :: CreateDBProxyEndpointResponse -> String
$cshow :: CreateDBProxyEndpointResponse -> String
showsPrec :: Int -> CreateDBProxyEndpointResponse -> ShowS
$cshowsPrec :: Int -> CreateDBProxyEndpointResponse -> ShowS
Prelude.Show, forall x.
Rep CreateDBProxyEndpointResponse x
-> CreateDBProxyEndpointResponse
forall x.
CreateDBProxyEndpointResponse
-> Rep CreateDBProxyEndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDBProxyEndpointResponse x
-> CreateDBProxyEndpointResponse
$cfrom :: forall x.
CreateDBProxyEndpointResponse
-> Rep CreateDBProxyEndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDBProxyEndpointResponse' 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:
--
-- 'dbProxyEndpoint', 'createDBProxyEndpointResponse_dbProxyEndpoint' - The @DBProxyEndpoint@ object that is created by the API operation. The
-- DB proxy endpoint that you create might provide capabilities such as
-- read\/write or read-only operations, or using a different VPC than the
-- proxy\'s default VPC.
--
-- 'httpStatus', 'createDBProxyEndpointResponse_httpStatus' - The response's http status code.
newCreateDBProxyEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDBProxyEndpointResponse
newCreateDBProxyEndpointResponse :: Int -> CreateDBProxyEndpointResponse
newCreateDBProxyEndpointResponse Int
pHttpStatus_ =
  CreateDBProxyEndpointResponse'
    { $sel:dbProxyEndpoint:CreateDBProxyEndpointResponse' :: Maybe DBProxyEndpoint
dbProxyEndpoint =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDBProxyEndpointResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The @DBProxyEndpoint@ object that is created by the API operation. The
-- DB proxy endpoint that you create might provide capabilities such as
-- read\/write or read-only operations, or using a different VPC than the
-- proxy\'s default VPC.
createDBProxyEndpointResponse_dbProxyEndpoint :: Lens.Lens' CreateDBProxyEndpointResponse (Prelude.Maybe DBProxyEndpoint)
createDBProxyEndpointResponse_dbProxyEndpoint :: Lens' CreateDBProxyEndpointResponse (Maybe DBProxyEndpoint)
createDBProxyEndpointResponse_dbProxyEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBProxyEndpointResponse' {Maybe DBProxyEndpoint
dbProxyEndpoint :: Maybe DBProxyEndpoint
$sel:dbProxyEndpoint:CreateDBProxyEndpointResponse' :: CreateDBProxyEndpointResponse -> Maybe DBProxyEndpoint
dbProxyEndpoint} -> Maybe DBProxyEndpoint
dbProxyEndpoint) (\s :: CreateDBProxyEndpointResponse
s@CreateDBProxyEndpointResponse' {} Maybe DBProxyEndpoint
a -> CreateDBProxyEndpointResponse
s {$sel:dbProxyEndpoint:CreateDBProxyEndpointResponse' :: Maybe DBProxyEndpoint
dbProxyEndpoint = Maybe DBProxyEndpoint
a} :: CreateDBProxyEndpointResponse)

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

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