{-# 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.Redshift.CreateEndpointAccess
-- 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 Redshift-managed VPC endpoint.
module Amazonka.Redshift.CreateEndpointAccess
  ( -- * Creating a Request
    CreateEndpointAccess (..),
    newCreateEndpointAccess,

    -- * Request Lenses
    createEndpointAccess_clusterIdentifier,
    createEndpointAccess_resourceOwner,
    createEndpointAccess_vpcSecurityGroupIds,
    createEndpointAccess_endpointName,
    createEndpointAccess_subnetGroupName,

    -- * Destructuring the Response
    EndpointAccess (..),
    newEndpointAccess,

    -- * Response Lenses
    endpointAccess_address,
    endpointAccess_clusterIdentifier,
    endpointAccess_endpointCreateTime,
    endpointAccess_endpointName,
    endpointAccess_endpointStatus,
    endpointAccess_port,
    endpointAccess_resourceOwner,
    endpointAccess_subnetGroupName,
    endpointAccess_vpcEndpoint,
    endpointAccess_vpcSecurityGroups,
  )
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.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateEndpointAccess' smart constructor.
data CreateEndpointAccess = CreateEndpointAccess'
  { -- | The cluster identifier of the cluster to access.
    CreateEndpointAccess -> Maybe Text
clusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services account ID of the owner of the cluster. This is
    -- only required if the cluster is in another Amazon Web Services account.
    CreateEndpointAccess -> Maybe Text
resourceOwner :: Prelude.Maybe Prelude.Text,
    -- | The security group that defines the ports, protocols, and sources for
    -- inbound traffic that you are authorizing into your endpoint.
    CreateEndpointAccess -> Maybe [Text]
vpcSecurityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The Redshift-managed VPC endpoint name.
    --
    -- An endpoint name must contain 1-30 characters. Valid characters are A-Z,
    -- a-z, 0-9, and hyphen(-). The first character must be a letter. The name
    -- can\'t contain two consecutive hyphens or end with a hyphen.
    CreateEndpointAccess -> Text
endpointName :: Prelude.Text,
    -- | The subnet group from which Amazon Redshift chooses the subnet to deploy
    -- the endpoint.
    CreateEndpointAccess -> Text
subnetGroupName :: Prelude.Text
  }
  deriving (CreateEndpointAccess -> CreateEndpointAccess -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEndpointAccess -> CreateEndpointAccess -> Bool
$c/= :: CreateEndpointAccess -> CreateEndpointAccess -> Bool
== :: CreateEndpointAccess -> CreateEndpointAccess -> Bool
$c== :: CreateEndpointAccess -> CreateEndpointAccess -> Bool
Prelude.Eq, ReadPrec [CreateEndpointAccess]
ReadPrec CreateEndpointAccess
Int -> ReadS CreateEndpointAccess
ReadS [CreateEndpointAccess]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEndpointAccess]
$creadListPrec :: ReadPrec [CreateEndpointAccess]
readPrec :: ReadPrec CreateEndpointAccess
$creadPrec :: ReadPrec CreateEndpointAccess
readList :: ReadS [CreateEndpointAccess]
$creadList :: ReadS [CreateEndpointAccess]
readsPrec :: Int -> ReadS CreateEndpointAccess
$creadsPrec :: Int -> ReadS CreateEndpointAccess
Prelude.Read, Int -> CreateEndpointAccess -> ShowS
[CreateEndpointAccess] -> ShowS
CreateEndpointAccess -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEndpointAccess] -> ShowS
$cshowList :: [CreateEndpointAccess] -> ShowS
show :: CreateEndpointAccess -> String
$cshow :: CreateEndpointAccess -> String
showsPrec :: Int -> CreateEndpointAccess -> ShowS
$cshowsPrec :: Int -> CreateEndpointAccess -> ShowS
Prelude.Show, forall x. Rep CreateEndpointAccess x -> CreateEndpointAccess
forall x. CreateEndpointAccess -> Rep CreateEndpointAccess x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateEndpointAccess x -> CreateEndpointAccess
$cfrom :: forall x. CreateEndpointAccess -> Rep CreateEndpointAccess x
Prelude.Generic)

-- |
-- Create a value of 'CreateEndpointAccess' 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:
--
-- 'clusterIdentifier', 'createEndpointAccess_clusterIdentifier' - The cluster identifier of the cluster to access.
--
-- 'resourceOwner', 'createEndpointAccess_resourceOwner' - The Amazon Web Services account ID of the owner of the cluster. This is
-- only required if the cluster is in another Amazon Web Services account.
--
-- 'vpcSecurityGroupIds', 'createEndpointAccess_vpcSecurityGroupIds' - The security group that defines the ports, protocols, and sources for
-- inbound traffic that you are authorizing into your endpoint.
--
-- 'endpointName', 'createEndpointAccess_endpointName' - The Redshift-managed VPC endpoint name.
--
-- An endpoint name must contain 1-30 characters. Valid characters are A-Z,
-- a-z, 0-9, and hyphen(-). The first character must be a letter. The name
-- can\'t contain two consecutive hyphens or end with a hyphen.
--
-- 'subnetGroupName', 'createEndpointAccess_subnetGroupName' - The subnet group from which Amazon Redshift chooses the subnet to deploy
-- the endpoint.
newCreateEndpointAccess ::
  -- | 'endpointName'
  Prelude.Text ->
  -- | 'subnetGroupName'
  Prelude.Text ->
  CreateEndpointAccess
newCreateEndpointAccess :: Text -> Text -> CreateEndpointAccess
newCreateEndpointAccess
  Text
pEndpointName_
  Text
pSubnetGroupName_ =
    CreateEndpointAccess'
      { $sel:clusterIdentifier:CreateEndpointAccess' :: Maybe Text
clusterIdentifier =
          forall a. Maybe a
Prelude.Nothing,
        $sel:resourceOwner:CreateEndpointAccess' :: Maybe Text
resourceOwner = forall a. Maybe a
Prelude.Nothing,
        $sel:vpcSecurityGroupIds:CreateEndpointAccess' :: Maybe [Text]
vpcSecurityGroupIds = forall a. Maybe a
Prelude.Nothing,
        $sel:endpointName:CreateEndpointAccess' :: Text
endpointName = Text
pEndpointName_,
        $sel:subnetGroupName:CreateEndpointAccess' :: Text
subnetGroupName = Text
pSubnetGroupName_
      }

-- | The cluster identifier of the cluster to access.
createEndpointAccess_clusterIdentifier :: Lens.Lens' CreateEndpointAccess (Prelude.Maybe Prelude.Text)
createEndpointAccess_clusterIdentifier :: Lens' CreateEndpointAccess (Maybe Text)
createEndpointAccess_clusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointAccess' {Maybe Text
clusterIdentifier :: Maybe Text
$sel:clusterIdentifier:CreateEndpointAccess' :: CreateEndpointAccess -> Maybe Text
clusterIdentifier} -> Maybe Text
clusterIdentifier) (\s :: CreateEndpointAccess
s@CreateEndpointAccess' {} Maybe Text
a -> CreateEndpointAccess
s {$sel:clusterIdentifier:CreateEndpointAccess' :: Maybe Text
clusterIdentifier = Maybe Text
a} :: CreateEndpointAccess)

-- | The Amazon Web Services account ID of the owner of the cluster. This is
-- only required if the cluster is in another Amazon Web Services account.
createEndpointAccess_resourceOwner :: Lens.Lens' CreateEndpointAccess (Prelude.Maybe Prelude.Text)
createEndpointAccess_resourceOwner :: Lens' CreateEndpointAccess (Maybe Text)
createEndpointAccess_resourceOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointAccess' {Maybe Text
resourceOwner :: Maybe Text
$sel:resourceOwner:CreateEndpointAccess' :: CreateEndpointAccess -> Maybe Text
resourceOwner} -> Maybe Text
resourceOwner) (\s :: CreateEndpointAccess
s@CreateEndpointAccess' {} Maybe Text
a -> CreateEndpointAccess
s {$sel:resourceOwner:CreateEndpointAccess' :: Maybe Text
resourceOwner = Maybe Text
a} :: CreateEndpointAccess)

-- | The security group that defines the ports, protocols, and sources for
-- inbound traffic that you are authorizing into your endpoint.
createEndpointAccess_vpcSecurityGroupIds :: Lens.Lens' CreateEndpointAccess (Prelude.Maybe [Prelude.Text])
createEndpointAccess_vpcSecurityGroupIds :: Lens' CreateEndpointAccess (Maybe [Text])
createEndpointAccess_vpcSecurityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointAccess' {Maybe [Text]
vpcSecurityGroupIds :: Maybe [Text]
$sel:vpcSecurityGroupIds:CreateEndpointAccess' :: CreateEndpointAccess -> Maybe [Text]
vpcSecurityGroupIds} -> Maybe [Text]
vpcSecurityGroupIds) (\s :: CreateEndpointAccess
s@CreateEndpointAccess' {} Maybe [Text]
a -> CreateEndpointAccess
s {$sel:vpcSecurityGroupIds:CreateEndpointAccess' :: Maybe [Text]
vpcSecurityGroupIds = Maybe [Text]
a} :: CreateEndpointAccess) 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 Redshift-managed VPC endpoint name.
--
-- An endpoint name must contain 1-30 characters. Valid characters are A-Z,
-- a-z, 0-9, and hyphen(-). The first character must be a letter. The name
-- can\'t contain two consecutive hyphens or end with a hyphen.
createEndpointAccess_endpointName :: Lens.Lens' CreateEndpointAccess Prelude.Text
createEndpointAccess_endpointName :: Lens' CreateEndpointAccess Text
createEndpointAccess_endpointName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointAccess' {Text
endpointName :: Text
$sel:endpointName:CreateEndpointAccess' :: CreateEndpointAccess -> Text
endpointName} -> Text
endpointName) (\s :: CreateEndpointAccess
s@CreateEndpointAccess' {} Text
a -> CreateEndpointAccess
s {$sel:endpointName:CreateEndpointAccess' :: Text
endpointName = Text
a} :: CreateEndpointAccess)

-- | The subnet group from which Amazon Redshift chooses the subnet to deploy
-- the endpoint.
createEndpointAccess_subnetGroupName :: Lens.Lens' CreateEndpointAccess Prelude.Text
createEndpointAccess_subnetGroupName :: Lens' CreateEndpointAccess Text
createEndpointAccess_subnetGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointAccess' {Text
subnetGroupName :: Text
$sel:subnetGroupName:CreateEndpointAccess' :: CreateEndpointAccess -> Text
subnetGroupName} -> Text
subnetGroupName) (\s :: CreateEndpointAccess
s@CreateEndpointAccess' {} Text
a -> CreateEndpointAccess
s {$sel:subnetGroupName:CreateEndpointAccess' :: Text
subnetGroupName = Text
a} :: CreateEndpointAccess)

instance Core.AWSRequest CreateEndpointAccess where
  type
    AWSResponse CreateEndpointAccess =
      EndpointAccess
  request :: (Service -> Service)
-> CreateEndpointAccess -> Request CreateEndpointAccess
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 CreateEndpointAccess
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateEndpointAccess)))
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
"CreateEndpointAccessResult"
      (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance Prelude.Hashable CreateEndpointAccess where
  hashWithSalt :: Int -> CreateEndpointAccess -> Int
hashWithSalt Int
_salt CreateEndpointAccess' {Maybe [Text]
Maybe Text
Text
subnetGroupName :: Text
endpointName :: Text
vpcSecurityGroupIds :: Maybe [Text]
resourceOwner :: Maybe Text
clusterIdentifier :: Maybe Text
$sel:subnetGroupName:CreateEndpointAccess' :: CreateEndpointAccess -> Text
$sel:endpointName:CreateEndpointAccess' :: CreateEndpointAccess -> Text
$sel:vpcSecurityGroupIds:CreateEndpointAccess' :: CreateEndpointAccess -> Maybe [Text]
$sel:resourceOwner:CreateEndpointAccess' :: CreateEndpointAccess -> Maybe Text
$sel:clusterIdentifier:CreateEndpointAccess' :: CreateEndpointAccess -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resourceOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
vpcSecurityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
subnetGroupName

instance Prelude.NFData CreateEndpointAccess where
  rnf :: CreateEndpointAccess -> ()
rnf CreateEndpointAccess' {Maybe [Text]
Maybe Text
Text
subnetGroupName :: Text
endpointName :: Text
vpcSecurityGroupIds :: Maybe [Text]
resourceOwner :: Maybe Text
clusterIdentifier :: Maybe Text
$sel:subnetGroupName:CreateEndpointAccess' :: CreateEndpointAccess -> Text
$sel:endpointName:CreateEndpointAccess' :: CreateEndpointAccess -> Text
$sel:vpcSecurityGroupIds:CreateEndpointAccess' :: CreateEndpointAccess -> Maybe [Text]
$sel:resourceOwner:CreateEndpointAccess' :: CreateEndpointAccess -> Maybe Text
$sel:clusterIdentifier:CreateEndpointAccess' :: CreateEndpointAccess -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceOwner
      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
endpointName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
subnetGroupName

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

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

instance Data.ToQuery CreateEndpointAccess where
  toQuery :: CreateEndpointAccess -> QueryString
toQuery CreateEndpointAccess' {Maybe [Text]
Maybe Text
Text
subnetGroupName :: Text
endpointName :: Text
vpcSecurityGroupIds :: Maybe [Text]
resourceOwner :: Maybe Text
clusterIdentifier :: Maybe Text
$sel:subnetGroupName:CreateEndpointAccess' :: CreateEndpointAccess -> Text
$sel:endpointName:CreateEndpointAccess' :: CreateEndpointAccess -> Text
$sel:vpcSecurityGroupIds:CreateEndpointAccess' :: CreateEndpointAccess -> Maybe [Text]
$sel:resourceOwner:CreateEndpointAccess' :: CreateEndpointAccess -> Maybe Text
$sel:clusterIdentifier:CreateEndpointAccess' :: CreateEndpointAccess -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateEndpointAccess" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"ClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clusterIdentifier,
        ByteString
"ResourceOwner" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
resourceOwner,
        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
"VpcSecurityGroupId"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
vpcSecurityGroupIds
            ),
        ByteString
"EndpointName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
endpointName,
        ByteString
"SubnetGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
subnetGroupName
      ]