{-# 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.OpenSearch.UpdateVpcEndpoint
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies an Amazon OpenSearch Service-managed interface VPC endpoint.
module Amazonka.OpenSearch.UpdateVpcEndpoint
  ( -- * Creating a Request
    UpdateVpcEndpoint (..),
    newUpdateVpcEndpoint,

    -- * Request Lenses
    updateVpcEndpoint_vpcEndpointId,
    updateVpcEndpoint_vpcOptions,

    -- * Destructuring the Response
    UpdateVpcEndpointResponse (..),
    newUpdateVpcEndpointResponse,

    -- * Response Lenses
    updateVpcEndpointResponse_httpStatus,
    updateVpcEndpointResponse_vpcEndpoint,
  )
where

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

-- | /See:/ 'newUpdateVpcEndpoint' smart constructor.
data UpdateVpcEndpoint = UpdateVpcEndpoint'
  { -- | The unique identifier of the endpoint.
    UpdateVpcEndpoint -> Text
vpcEndpointId :: Prelude.Text,
    -- | The security groups and\/or subnets to add, remove, or modify.
    UpdateVpcEndpoint -> VPCOptions
vpcOptions :: VPCOptions
  }
  deriving (UpdateVpcEndpoint -> UpdateVpcEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateVpcEndpoint -> UpdateVpcEndpoint -> Bool
$c/= :: UpdateVpcEndpoint -> UpdateVpcEndpoint -> Bool
== :: UpdateVpcEndpoint -> UpdateVpcEndpoint -> Bool
$c== :: UpdateVpcEndpoint -> UpdateVpcEndpoint -> Bool
Prelude.Eq, ReadPrec [UpdateVpcEndpoint]
ReadPrec UpdateVpcEndpoint
Int -> ReadS UpdateVpcEndpoint
ReadS [UpdateVpcEndpoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateVpcEndpoint]
$creadListPrec :: ReadPrec [UpdateVpcEndpoint]
readPrec :: ReadPrec UpdateVpcEndpoint
$creadPrec :: ReadPrec UpdateVpcEndpoint
readList :: ReadS [UpdateVpcEndpoint]
$creadList :: ReadS [UpdateVpcEndpoint]
readsPrec :: Int -> ReadS UpdateVpcEndpoint
$creadsPrec :: Int -> ReadS UpdateVpcEndpoint
Prelude.Read, Int -> UpdateVpcEndpoint -> ShowS
[UpdateVpcEndpoint] -> ShowS
UpdateVpcEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateVpcEndpoint] -> ShowS
$cshowList :: [UpdateVpcEndpoint] -> ShowS
show :: UpdateVpcEndpoint -> String
$cshow :: UpdateVpcEndpoint -> String
showsPrec :: Int -> UpdateVpcEndpoint -> ShowS
$cshowsPrec :: Int -> UpdateVpcEndpoint -> ShowS
Prelude.Show, forall x. Rep UpdateVpcEndpoint x -> UpdateVpcEndpoint
forall x. UpdateVpcEndpoint -> Rep UpdateVpcEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateVpcEndpoint x -> UpdateVpcEndpoint
$cfrom :: forall x. UpdateVpcEndpoint -> Rep UpdateVpcEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'UpdateVpcEndpoint' 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:
--
-- 'vpcEndpointId', 'updateVpcEndpoint_vpcEndpointId' - The unique identifier of the endpoint.
--
-- 'vpcOptions', 'updateVpcEndpoint_vpcOptions' - The security groups and\/or subnets to add, remove, or modify.
newUpdateVpcEndpoint ::
  -- | 'vpcEndpointId'
  Prelude.Text ->
  -- | 'vpcOptions'
  VPCOptions ->
  UpdateVpcEndpoint
newUpdateVpcEndpoint :: Text -> VPCOptions -> UpdateVpcEndpoint
newUpdateVpcEndpoint Text
pVpcEndpointId_ VPCOptions
pVpcOptions_ =
  UpdateVpcEndpoint'
    { $sel:vpcEndpointId:UpdateVpcEndpoint' :: Text
vpcEndpointId = Text
pVpcEndpointId_,
      $sel:vpcOptions:UpdateVpcEndpoint' :: VPCOptions
vpcOptions = VPCOptions
pVpcOptions_
    }

-- | The unique identifier of the endpoint.
updateVpcEndpoint_vpcEndpointId :: Lens.Lens' UpdateVpcEndpoint Prelude.Text
updateVpcEndpoint_vpcEndpointId :: Lens' UpdateVpcEndpoint Text
updateVpcEndpoint_vpcEndpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVpcEndpoint' {Text
vpcEndpointId :: Text
$sel:vpcEndpointId:UpdateVpcEndpoint' :: UpdateVpcEndpoint -> Text
vpcEndpointId} -> Text
vpcEndpointId) (\s :: UpdateVpcEndpoint
s@UpdateVpcEndpoint' {} Text
a -> UpdateVpcEndpoint
s {$sel:vpcEndpointId:UpdateVpcEndpoint' :: Text
vpcEndpointId = Text
a} :: UpdateVpcEndpoint)

-- | The security groups and\/or subnets to add, remove, or modify.
updateVpcEndpoint_vpcOptions :: Lens.Lens' UpdateVpcEndpoint VPCOptions
updateVpcEndpoint_vpcOptions :: Lens' UpdateVpcEndpoint VPCOptions
updateVpcEndpoint_vpcOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVpcEndpoint' {VPCOptions
vpcOptions :: VPCOptions
$sel:vpcOptions:UpdateVpcEndpoint' :: UpdateVpcEndpoint -> VPCOptions
vpcOptions} -> VPCOptions
vpcOptions) (\s :: UpdateVpcEndpoint
s@UpdateVpcEndpoint' {} VPCOptions
a -> UpdateVpcEndpoint
s {$sel:vpcOptions:UpdateVpcEndpoint' :: VPCOptions
vpcOptions = VPCOptions
a} :: UpdateVpcEndpoint)

instance Core.AWSRequest UpdateVpcEndpoint where
  type
    AWSResponse UpdateVpcEndpoint =
      UpdateVpcEndpointResponse
  request :: (Service -> Service)
-> UpdateVpcEndpoint -> Request UpdateVpcEndpoint
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 UpdateVpcEndpoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateVpcEndpoint)))
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 -> UpdateVpcEndpointResponse
UpdateVpcEndpointResponse'
            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 UpdateVpcEndpoint where
  hashWithSalt :: Int -> UpdateVpcEndpoint -> Int
hashWithSalt Int
_salt UpdateVpcEndpoint' {Text
VPCOptions
vpcOptions :: VPCOptions
vpcEndpointId :: Text
$sel:vpcOptions:UpdateVpcEndpoint' :: UpdateVpcEndpoint -> VPCOptions
$sel:vpcEndpointId:UpdateVpcEndpoint' :: UpdateVpcEndpoint -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vpcEndpointId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VPCOptions
vpcOptions

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

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

instance Data.ToJSON UpdateVpcEndpoint where
  toJSON :: UpdateVpcEndpoint -> Value
toJSON UpdateVpcEndpoint' {Text
VPCOptions
vpcOptions :: VPCOptions
vpcEndpointId :: Text
$sel:vpcOptions:UpdateVpcEndpoint' :: UpdateVpcEndpoint -> VPCOptions
$sel:vpcEndpointId:UpdateVpcEndpoint' :: UpdateVpcEndpoint -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"VpcEndpointId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
vpcEndpointId),
            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 UpdateVpcEndpoint where
  toPath :: UpdateVpcEndpoint -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/2021-01-01/opensearch/vpcEndpoints/update"

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

-- | /See:/ 'newUpdateVpcEndpointResponse' smart constructor.
data UpdateVpcEndpointResponse = UpdateVpcEndpointResponse'
  { -- | The response's http status code.
    UpdateVpcEndpointResponse -> Int
httpStatus :: Prelude.Int,
    -- | The endpoint to be updated.
    UpdateVpcEndpointResponse -> VpcEndpoint
vpcEndpoint :: VpcEndpoint
  }
  deriving (UpdateVpcEndpointResponse -> UpdateVpcEndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateVpcEndpointResponse -> UpdateVpcEndpointResponse -> Bool
$c/= :: UpdateVpcEndpointResponse -> UpdateVpcEndpointResponse -> Bool
== :: UpdateVpcEndpointResponse -> UpdateVpcEndpointResponse -> Bool
$c== :: UpdateVpcEndpointResponse -> UpdateVpcEndpointResponse -> Bool
Prelude.Eq, ReadPrec [UpdateVpcEndpointResponse]
ReadPrec UpdateVpcEndpointResponse
Int -> ReadS UpdateVpcEndpointResponse
ReadS [UpdateVpcEndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateVpcEndpointResponse]
$creadListPrec :: ReadPrec [UpdateVpcEndpointResponse]
readPrec :: ReadPrec UpdateVpcEndpointResponse
$creadPrec :: ReadPrec UpdateVpcEndpointResponse
readList :: ReadS [UpdateVpcEndpointResponse]
$creadList :: ReadS [UpdateVpcEndpointResponse]
readsPrec :: Int -> ReadS UpdateVpcEndpointResponse
$creadsPrec :: Int -> ReadS UpdateVpcEndpointResponse
Prelude.Read, Int -> UpdateVpcEndpointResponse -> ShowS
[UpdateVpcEndpointResponse] -> ShowS
UpdateVpcEndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateVpcEndpointResponse] -> ShowS
$cshowList :: [UpdateVpcEndpointResponse] -> ShowS
show :: UpdateVpcEndpointResponse -> String
$cshow :: UpdateVpcEndpointResponse -> String
showsPrec :: Int -> UpdateVpcEndpointResponse -> ShowS
$cshowsPrec :: Int -> UpdateVpcEndpointResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateVpcEndpointResponse x -> UpdateVpcEndpointResponse
forall x.
UpdateVpcEndpointResponse -> Rep UpdateVpcEndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateVpcEndpointResponse x -> UpdateVpcEndpointResponse
$cfrom :: forall x.
UpdateVpcEndpointResponse -> Rep UpdateVpcEndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateVpcEndpointResponse' 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', 'updateVpcEndpointResponse_httpStatus' - The response's http status code.
--
-- 'vpcEndpoint', 'updateVpcEndpointResponse_vpcEndpoint' - The endpoint to be updated.
newUpdateVpcEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'vpcEndpoint'
  VpcEndpoint ->
  UpdateVpcEndpointResponse
newUpdateVpcEndpointResponse :: Int -> VpcEndpoint -> UpdateVpcEndpointResponse
newUpdateVpcEndpointResponse
  Int
pHttpStatus_
  VpcEndpoint
pVpcEndpoint_ =
    UpdateVpcEndpointResponse'
      { $sel:httpStatus:UpdateVpcEndpointResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:vpcEndpoint:UpdateVpcEndpointResponse' :: VpcEndpoint
vpcEndpoint = VpcEndpoint
pVpcEndpoint_
      }

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

-- | The endpoint to be updated.
updateVpcEndpointResponse_vpcEndpoint :: Lens.Lens' UpdateVpcEndpointResponse VpcEndpoint
updateVpcEndpointResponse_vpcEndpoint :: Lens' UpdateVpcEndpointResponse VpcEndpoint
updateVpcEndpointResponse_vpcEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVpcEndpointResponse' {VpcEndpoint
vpcEndpoint :: VpcEndpoint
$sel:vpcEndpoint:UpdateVpcEndpointResponse' :: UpdateVpcEndpointResponse -> VpcEndpoint
vpcEndpoint} -> VpcEndpoint
vpcEndpoint) (\s :: UpdateVpcEndpointResponse
s@UpdateVpcEndpointResponse' {} VpcEndpoint
a -> UpdateVpcEndpointResponse
s {$sel:vpcEndpoint:UpdateVpcEndpointResponse' :: VpcEndpoint
vpcEndpoint = VpcEndpoint
a} :: UpdateVpcEndpointResponse)

instance Prelude.NFData UpdateVpcEndpointResponse where
  rnf :: UpdateVpcEndpointResponse -> ()
rnf UpdateVpcEndpointResponse' {Int
VpcEndpoint
vpcEndpoint :: VpcEndpoint
httpStatus :: Int
$sel:vpcEndpoint:UpdateVpcEndpointResponse' :: UpdateVpcEndpointResponse -> VpcEndpoint
$sel:httpStatus:UpdateVpcEndpointResponse' :: UpdateVpcEndpointResponse -> 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