{-# 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.ElasticSearch.CreateVpcEndpoint
-- 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 an Amazon OpenSearch Service-managed VPC endpoint.
module Amazonka.ElasticSearch.CreateVpcEndpoint
  ( -- * Creating a Request
    CreateVpcEndpoint (..),
    newCreateVpcEndpoint,

    -- * Request Lenses
    createVpcEndpoint_clientToken,
    createVpcEndpoint_domainArn,
    createVpcEndpoint_vpcOptions,

    -- * Destructuring the Response
    CreateVpcEndpointResponse (..),
    newCreateVpcEndpointResponse,

    -- * Response Lenses
    createVpcEndpointResponse_httpStatus,
    createVpcEndpointResponse_vpcEndpoint,
  )
where

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

-- | Container for the parameters to the @CreateVpcEndpointRequest@
-- operation.
--
-- /See:/ 'newCreateVpcEndpoint' smart constructor.
data CreateVpcEndpoint = CreateVpcEndpoint'
  { -- | Unique, case-sensitive identifier to ensure idempotency of the request.
    CreateVpcEndpoint -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the domain to grant access to.
    CreateVpcEndpoint -> Text
domainArn :: Prelude.Text,
    -- | Options to specify the subnets and security groups for the endpoint.
    CreateVpcEndpoint -> VPCOptions
vpcOptions :: VPCOptions
  }
  deriving (CreateVpcEndpoint -> CreateVpcEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVpcEndpoint -> CreateVpcEndpoint -> Bool
$c/= :: CreateVpcEndpoint -> CreateVpcEndpoint -> Bool
== :: CreateVpcEndpoint -> CreateVpcEndpoint -> Bool
$c== :: CreateVpcEndpoint -> CreateVpcEndpoint -> Bool
Prelude.Eq, ReadPrec [CreateVpcEndpoint]
ReadPrec CreateVpcEndpoint
Int -> ReadS CreateVpcEndpoint
ReadS [CreateVpcEndpoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVpcEndpoint]
$creadListPrec :: ReadPrec [CreateVpcEndpoint]
readPrec :: ReadPrec CreateVpcEndpoint
$creadPrec :: ReadPrec CreateVpcEndpoint
readList :: ReadS [CreateVpcEndpoint]
$creadList :: ReadS [CreateVpcEndpoint]
readsPrec :: Int -> ReadS CreateVpcEndpoint
$creadsPrec :: Int -> ReadS CreateVpcEndpoint
Prelude.Read, Int -> CreateVpcEndpoint -> ShowS
[CreateVpcEndpoint] -> ShowS
CreateVpcEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVpcEndpoint] -> ShowS
$cshowList :: [CreateVpcEndpoint] -> ShowS
show :: CreateVpcEndpoint -> String
$cshow :: CreateVpcEndpoint -> String
showsPrec :: Int -> CreateVpcEndpoint -> ShowS
$cshowsPrec :: Int -> CreateVpcEndpoint -> ShowS
Prelude.Show, forall x. Rep CreateVpcEndpoint x -> CreateVpcEndpoint
forall x. CreateVpcEndpoint -> Rep CreateVpcEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateVpcEndpoint x -> CreateVpcEndpoint
$cfrom :: forall x. CreateVpcEndpoint -> Rep CreateVpcEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'CreateVpcEndpoint' 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:
--
-- 'clientToken', 'createVpcEndpoint_clientToken' - Unique, case-sensitive identifier to ensure idempotency of the request.
--
-- 'domainArn', 'createVpcEndpoint_domainArn' - The Amazon Resource Name (ARN) of the domain to grant access to.
--
-- 'vpcOptions', 'createVpcEndpoint_vpcOptions' - Options to specify the subnets and security groups for the endpoint.
newCreateVpcEndpoint ::
  -- | 'domainArn'
  Prelude.Text ->
  -- | 'vpcOptions'
  VPCOptions ->
  CreateVpcEndpoint
newCreateVpcEndpoint :: Text -> VPCOptions -> CreateVpcEndpoint
newCreateVpcEndpoint Text
pDomainArn_ VPCOptions
pVpcOptions_ =
  CreateVpcEndpoint'
    { $sel:clientToken:CreateVpcEndpoint' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:domainArn:CreateVpcEndpoint' :: Text
domainArn = Text
pDomainArn_,
      $sel:vpcOptions:CreateVpcEndpoint' :: VPCOptions
vpcOptions = VPCOptions
pVpcOptions_
    }

-- | Unique, case-sensitive identifier to ensure idempotency of the request.
createVpcEndpoint_clientToken :: Lens.Lens' CreateVpcEndpoint (Prelude.Maybe Prelude.Text)
createVpcEndpoint_clientToken :: Lens' CreateVpcEndpoint (Maybe Text)
createVpcEndpoint_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Maybe Text
a -> CreateVpcEndpoint
s {$sel:clientToken:CreateVpcEndpoint' :: Maybe Text
clientToken = Maybe Text
a} :: CreateVpcEndpoint)

-- | The Amazon Resource Name (ARN) of the domain to grant access to.
createVpcEndpoint_domainArn :: Lens.Lens' CreateVpcEndpoint Prelude.Text
createVpcEndpoint_domainArn :: Lens' CreateVpcEndpoint Text
createVpcEndpoint_domainArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {Text
domainArn :: Text
$sel:domainArn:CreateVpcEndpoint' :: CreateVpcEndpoint -> Text
domainArn} -> Text
domainArn) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} Text
a -> CreateVpcEndpoint
s {$sel:domainArn:CreateVpcEndpoint' :: Text
domainArn = Text
a} :: CreateVpcEndpoint)

-- | Options to specify the subnets and security groups for the endpoint.
createVpcEndpoint_vpcOptions :: Lens.Lens' CreateVpcEndpoint VPCOptions
createVpcEndpoint_vpcOptions :: Lens' CreateVpcEndpoint VPCOptions
createVpcEndpoint_vpcOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpoint' {VPCOptions
vpcOptions :: VPCOptions
$sel:vpcOptions:CreateVpcEndpoint' :: CreateVpcEndpoint -> VPCOptions
vpcOptions} -> VPCOptions
vpcOptions) (\s :: CreateVpcEndpoint
s@CreateVpcEndpoint' {} VPCOptions
a -> CreateVpcEndpoint
s {$sel:vpcOptions:CreateVpcEndpoint' :: VPCOptions
vpcOptions = VPCOptions
a} :: CreateVpcEndpoint)

instance Core.AWSRequest CreateVpcEndpoint where
  type
    AWSResponse CreateVpcEndpoint =
      CreateVpcEndpointResponse
  request :: (Service -> Service)
-> CreateVpcEndpoint -> Request CreateVpcEndpoint
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateVpcEndpoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateVpcEndpoint)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> VpcEndpoint -> CreateVpcEndpointResponse
CreateVpcEndpointResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"VpcEndpoint")
      )

instance Prelude.Hashable CreateVpcEndpoint where
  hashWithSalt :: Int -> CreateVpcEndpoint -> Int
hashWithSalt Int
_salt CreateVpcEndpoint' {Maybe Text
Text
VPCOptions
vpcOptions :: VPCOptions
domainArn :: Text
clientToken :: Maybe Text
$sel:vpcOptions:CreateVpcEndpoint' :: CreateVpcEndpoint -> VPCOptions
$sel:domainArn:CreateVpcEndpoint' :: CreateVpcEndpoint -> Text
$sel:clientToken:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VPCOptions
vpcOptions

instance Prelude.NFData CreateVpcEndpoint where
  rnf :: CreateVpcEndpoint -> ()
rnf CreateVpcEndpoint' {Maybe Text
Text
VPCOptions
vpcOptions :: VPCOptions
domainArn :: Text
clientToken :: Maybe Text
$sel:vpcOptions:CreateVpcEndpoint' :: CreateVpcEndpoint -> VPCOptions
$sel:domainArn:CreateVpcEndpoint' :: CreateVpcEndpoint -> Text
$sel:clientToken:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VPCOptions
vpcOptions

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

instance Data.ToJSON CreateVpcEndpoint where
  toJSON :: CreateVpcEndpoint -> Value
toJSON CreateVpcEndpoint' {Maybe Text
Text
VPCOptions
vpcOptions :: VPCOptions
domainArn :: Text
clientToken :: Maybe Text
$sel:vpcOptions:CreateVpcEndpoint' :: CreateVpcEndpoint -> VPCOptions
$sel:domainArn:CreateVpcEndpoint' :: CreateVpcEndpoint -> Text
$sel:clientToken:CreateVpcEndpoint' :: CreateVpcEndpoint -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"DomainArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"VpcOptions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= VPCOptions
vpcOptions)
          ]
      )

instance Data.ToPath CreateVpcEndpoint where
  toPath :: CreateVpcEndpoint -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2015-01-01/es/vpcEndpoints"

instance Data.ToQuery CreateVpcEndpoint where
  toQuery :: CreateVpcEndpoint -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | Container for response parameters to the @CreateVpcEndpoint@ operation.
-- Contains the configuration and status of the VPC Endpoint being created.
--
-- /See:/ 'newCreateVpcEndpointResponse' smart constructor.
data CreateVpcEndpointResponse = CreateVpcEndpointResponse'
  { -- | The response's http status code.
    CreateVpcEndpointResponse -> Int
httpStatus :: Prelude.Int,
    -- | Information about the newly created VPC endpoint.
    CreateVpcEndpointResponse -> VpcEndpoint
vpcEndpoint :: VpcEndpoint
  }
  deriving (CreateVpcEndpointResponse -> CreateVpcEndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVpcEndpointResponse -> CreateVpcEndpointResponse -> Bool
$c/= :: CreateVpcEndpointResponse -> CreateVpcEndpointResponse -> Bool
== :: CreateVpcEndpointResponse -> CreateVpcEndpointResponse -> Bool
$c== :: CreateVpcEndpointResponse -> CreateVpcEndpointResponse -> Bool
Prelude.Eq, ReadPrec [CreateVpcEndpointResponse]
ReadPrec CreateVpcEndpointResponse
Int -> ReadS CreateVpcEndpointResponse
ReadS [CreateVpcEndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVpcEndpointResponse]
$creadListPrec :: ReadPrec [CreateVpcEndpointResponse]
readPrec :: ReadPrec CreateVpcEndpointResponse
$creadPrec :: ReadPrec CreateVpcEndpointResponse
readList :: ReadS [CreateVpcEndpointResponse]
$creadList :: ReadS [CreateVpcEndpointResponse]
readsPrec :: Int -> ReadS CreateVpcEndpointResponse
$creadsPrec :: Int -> ReadS CreateVpcEndpointResponse
Prelude.Read, Int -> CreateVpcEndpointResponse -> ShowS
[CreateVpcEndpointResponse] -> ShowS
CreateVpcEndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVpcEndpointResponse] -> ShowS
$cshowList :: [CreateVpcEndpointResponse] -> ShowS
show :: CreateVpcEndpointResponse -> String
$cshow :: CreateVpcEndpointResponse -> String
showsPrec :: Int -> CreateVpcEndpointResponse -> ShowS
$cshowsPrec :: Int -> CreateVpcEndpointResponse -> ShowS
Prelude.Show, forall x.
Rep CreateVpcEndpointResponse x -> CreateVpcEndpointResponse
forall x.
CreateVpcEndpointResponse -> Rep CreateVpcEndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateVpcEndpointResponse x -> CreateVpcEndpointResponse
$cfrom :: forall x.
CreateVpcEndpointResponse -> Rep CreateVpcEndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateVpcEndpointResponse' 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:
--
-- 'httpStatus', 'createVpcEndpointResponse_httpStatus' - The response's http status code.
--
-- 'vpcEndpoint', 'createVpcEndpointResponse_vpcEndpoint' - Information about the newly created VPC endpoint.
newCreateVpcEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'vpcEndpoint'
  VpcEndpoint ->
  CreateVpcEndpointResponse
newCreateVpcEndpointResponse :: Int -> VpcEndpoint -> CreateVpcEndpointResponse
newCreateVpcEndpointResponse
  Int
pHttpStatus_
  VpcEndpoint
pVpcEndpoint_ =
    CreateVpcEndpointResponse'
      { $sel:httpStatus:CreateVpcEndpointResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:vpcEndpoint:CreateVpcEndpointResponse' :: VpcEndpoint
vpcEndpoint = VpcEndpoint
pVpcEndpoint_
      }

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

-- | Information about the newly created VPC endpoint.
createVpcEndpointResponse_vpcEndpoint :: Lens.Lens' CreateVpcEndpointResponse VpcEndpoint
createVpcEndpointResponse_vpcEndpoint :: Lens' CreateVpcEndpointResponse VpcEndpoint
createVpcEndpointResponse_vpcEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcEndpointResponse' {VpcEndpoint
vpcEndpoint :: VpcEndpoint
$sel:vpcEndpoint:CreateVpcEndpointResponse' :: CreateVpcEndpointResponse -> VpcEndpoint
vpcEndpoint} -> VpcEndpoint
vpcEndpoint) (\s :: CreateVpcEndpointResponse
s@CreateVpcEndpointResponse' {} VpcEndpoint
a -> CreateVpcEndpointResponse
s {$sel:vpcEndpoint:CreateVpcEndpointResponse' :: VpcEndpoint
vpcEndpoint = VpcEndpoint
a} :: CreateVpcEndpointResponse)

instance Prelude.NFData CreateVpcEndpointResponse where
  rnf :: CreateVpcEndpointResponse -> ()
rnf CreateVpcEndpointResponse' {Int
VpcEndpoint
vpcEndpoint :: VpcEndpoint
httpStatus :: Int
$sel:vpcEndpoint:CreateVpcEndpointResponse' :: CreateVpcEndpointResponse -> VpcEndpoint
$sel:httpStatus:CreateVpcEndpointResponse' :: CreateVpcEndpointResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VpcEndpoint
vpcEndpoint