{-# 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.EMRContainers.DeleteManagedEndpoint
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a managed endpoint. A managed endpoint is a gateway that
-- connects EMR Studio to Amazon EMR on EKS so that EMR Studio can
-- communicate with your virtual cluster.
module Amazonka.EMRContainers.DeleteManagedEndpoint
  ( -- * Creating a Request
    DeleteManagedEndpoint (..),
    newDeleteManagedEndpoint,

    -- * Request Lenses
    deleteManagedEndpoint_id,
    deleteManagedEndpoint_virtualClusterId,

    -- * Destructuring the Response
    DeleteManagedEndpointResponse (..),
    newDeleteManagedEndpointResponse,

    -- * Response Lenses
    deleteManagedEndpointResponse_id,
    deleteManagedEndpointResponse_virtualClusterId,
    deleteManagedEndpointResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeleteManagedEndpoint' smart constructor.
data DeleteManagedEndpoint = DeleteManagedEndpoint'
  { -- | The ID of the managed endpoint.
    DeleteManagedEndpoint -> Text
id :: Prelude.Text,
    -- | The ID of the endpoint\'s virtual cluster.
    DeleteManagedEndpoint -> Text
virtualClusterId :: Prelude.Text
  }
  deriving (DeleteManagedEndpoint -> DeleteManagedEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteManagedEndpoint -> DeleteManagedEndpoint -> Bool
$c/= :: DeleteManagedEndpoint -> DeleteManagedEndpoint -> Bool
== :: DeleteManagedEndpoint -> DeleteManagedEndpoint -> Bool
$c== :: DeleteManagedEndpoint -> DeleteManagedEndpoint -> Bool
Prelude.Eq, ReadPrec [DeleteManagedEndpoint]
ReadPrec DeleteManagedEndpoint
Int -> ReadS DeleteManagedEndpoint
ReadS [DeleteManagedEndpoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteManagedEndpoint]
$creadListPrec :: ReadPrec [DeleteManagedEndpoint]
readPrec :: ReadPrec DeleteManagedEndpoint
$creadPrec :: ReadPrec DeleteManagedEndpoint
readList :: ReadS [DeleteManagedEndpoint]
$creadList :: ReadS [DeleteManagedEndpoint]
readsPrec :: Int -> ReadS DeleteManagedEndpoint
$creadsPrec :: Int -> ReadS DeleteManagedEndpoint
Prelude.Read, Int -> DeleteManagedEndpoint -> ShowS
[DeleteManagedEndpoint] -> ShowS
DeleteManagedEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteManagedEndpoint] -> ShowS
$cshowList :: [DeleteManagedEndpoint] -> ShowS
show :: DeleteManagedEndpoint -> String
$cshow :: DeleteManagedEndpoint -> String
showsPrec :: Int -> DeleteManagedEndpoint -> ShowS
$cshowsPrec :: Int -> DeleteManagedEndpoint -> ShowS
Prelude.Show, forall x. Rep DeleteManagedEndpoint x -> DeleteManagedEndpoint
forall x. DeleteManagedEndpoint -> Rep DeleteManagedEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteManagedEndpoint x -> DeleteManagedEndpoint
$cfrom :: forall x. DeleteManagedEndpoint -> Rep DeleteManagedEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'DeleteManagedEndpoint' 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:
--
-- 'id', 'deleteManagedEndpoint_id' - The ID of the managed endpoint.
--
-- 'virtualClusterId', 'deleteManagedEndpoint_virtualClusterId' - The ID of the endpoint\'s virtual cluster.
newDeleteManagedEndpoint ::
  -- | 'id'
  Prelude.Text ->
  -- | 'virtualClusterId'
  Prelude.Text ->
  DeleteManagedEndpoint
newDeleteManagedEndpoint :: Text -> Text -> DeleteManagedEndpoint
newDeleteManagedEndpoint Text
pId_ Text
pVirtualClusterId_ =
  DeleteManagedEndpoint'
    { $sel:id:DeleteManagedEndpoint' :: Text
id = Text
pId_,
      $sel:virtualClusterId:DeleteManagedEndpoint' :: Text
virtualClusterId = Text
pVirtualClusterId_
    }

-- | The ID of the managed endpoint.
deleteManagedEndpoint_id :: Lens.Lens' DeleteManagedEndpoint Prelude.Text
deleteManagedEndpoint_id :: Lens' DeleteManagedEndpoint Text
deleteManagedEndpoint_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteManagedEndpoint' {Text
id :: Text
$sel:id:DeleteManagedEndpoint' :: DeleteManagedEndpoint -> Text
id} -> Text
id) (\s :: DeleteManagedEndpoint
s@DeleteManagedEndpoint' {} Text
a -> DeleteManagedEndpoint
s {$sel:id:DeleteManagedEndpoint' :: Text
id = Text
a} :: DeleteManagedEndpoint)

-- | The ID of the endpoint\'s virtual cluster.
deleteManagedEndpoint_virtualClusterId :: Lens.Lens' DeleteManagedEndpoint Prelude.Text
deleteManagedEndpoint_virtualClusterId :: Lens' DeleteManagedEndpoint Text
deleteManagedEndpoint_virtualClusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteManagedEndpoint' {Text
virtualClusterId :: Text
$sel:virtualClusterId:DeleteManagedEndpoint' :: DeleteManagedEndpoint -> Text
virtualClusterId} -> Text
virtualClusterId) (\s :: DeleteManagedEndpoint
s@DeleteManagedEndpoint' {} Text
a -> DeleteManagedEndpoint
s {$sel:virtualClusterId:DeleteManagedEndpoint' :: Text
virtualClusterId = Text
a} :: DeleteManagedEndpoint)

instance Core.AWSRequest DeleteManagedEndpoint where
  type
    AWSResponse DeleteManagedEndpoint =
      DeleteManagedEndpointResponse
  request :: (Service -> Service)
-> DeleteManagedEndpoint -> Request DeleteManagedEndpoint
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteManagedEndpoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteManagedEndpoint)))
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 ->
          Maybe Text -> Maybe Text -> Int -> DeleteManagedEndpointResponse
DeleteManagedEndpointResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"id")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"virtualClusterId")
            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 DeleteManagedEndpoint where
  hashWithSalt :: Int -> DeleteManagedEndpoint -> Int
hashWithSalt Int
_salt DeleteManagedEndpoint' {Text
virtualClusterId :: Text
id :: Text
$sel:virtualClusterId:DeleteManagedEndpoint' :: DeleteManagedEndpoint -> Text
$sel:id:DeleteManagedEndpoint' :: DeleteManagedEndpoint -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
virtualClusterId

instance Prelude.NFData DeleteManagedEndpoint where
  rnf :: DeleteManagedEndpoint -> ()
rnf DeleteManagedEndpoint' {Text
virtualClusterId :: Text
id :: Text
$sel:virtualClusterId:DeleteManagedEndpoint' :: DeleteManagedEndpoint -> Text
$sel:id:DeleteManagedEndpoint' :: DeleteManagedEndpoint -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
virtualClusterId

instance Data.ToHeaders DeleteManagedEndpoint where
  toHeaders :: DeleteManagedEndpoint -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DeleteManagedEndpoint where
  toPath :: DeleteManagedEndpoint -> ByteString
toPath DeleteManagedEndpoint' {Text
virtualClusterId :: Text
id :: Text
$sel:virtualClusterId:DeleteManagedEndpoint' :: DeleteManagedEndpoint -> Text
$sel:id:DeleteManagedEndpoint' :: DeleteManagedEndpoint -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/virtualclusters/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
virtualClusterId,
        ByteString
"/endpoints/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
id
      ]

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

-- | /See:/ 'newDeleteManagedEndpointResponse' smart constructor.
data DeleteManagedEndpointResponse = DeleteManagedEndpointResponse'
  { -- | The output displays the ID of the managed endpoint.
    DeleteManagedEndpointResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The output displays the ID of the endpoint\'s virtual cluster.
    DeleteManagedEndpointResponse -> Maybe Text
virtualClusterId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DeleteManagedEndpointResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteManagedEndpointResponse
-> DeleteManagedEndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteManagedEndpointResponse
-> DeleteManagedEndpointResponse -> Bool
$c/= :: DeleteManagedEndpointResponse
-> DeleteManagedEndpointResponse -> Bool
== :: DeleteManagedEndpointResponse
-> DeleteManagedEndpointResponse -> Bool
$c== :: DeleteManagedEndpointResponse
-> DeleteManagedEndpointResponse -> Bool
Prelude.Eq, ReadPrec [DeleteManagedEndpointResponse]
ReadPrec DeleteManagedEndpointResponse
Int -> ReadS DeleteManagedEndpointResponse
ReadS [DeleteManagedEndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteManagedEndpointResponse]
$creadListPrec :: ReadPrec [DeleteManagedEndpointResponse]
readPrec :: ReadPrec DeleteManagedEndpointResponse
$creadPrec :: ReadPrec DeleteManagedEndpointResponse
readList :: ReadS [DeleteManagedEndpointResponse]
$creadList :: ReadS [DeleteManagedEndpointResponse]
readsPrec :: Int -> ReadS DeleteManagedEndpointResponse
$creadsPrec :: Int -> ReadS DeleteManagedEndpointResponse
Prelude.Read, Int -> DeleteManagedEndpointResponse -> ShowS
[DeleteManagedEndpointResponse] -> ShowS
DeleteManagedEndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteManagedEndpointResponse] -> ShowS
$cshowList :: [DeleteManagedEndpointResponse] -> ShowS
show :: DeleteManagedEndpointResponse -> String
$cshow :: DeleteManagedEndpointResponse -> String
showsPrec :: Int -> DeleteManagedEndpointResponse -> ShowS
$cshowsPrec :: Int -> DeleteManagedEndpointResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteManagedEndpointResponse x
-> DeleteManagedEndpointResponse
forall x.
DeleteManagedEndpointResponse
-> Rep DeleteManagedEndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteManagedEndpointResponse x
-> DeleteManagedEndpointResponse
$cfrom :: forall x.
DeleteManagedEndpointResponse
-> Rep DeleteManagedEndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteManagedEndpointResponse' 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:
--
-- 'id', 'deleteManagedEndpointResponse_id' - The output displays the ID of the managed endpoint.
--
-- 'virtualClusterId', 'deleteManagedEndpointResponse_virtualClusterId' - The output displays the ID of the endpoint\'s virtual cluster.
--
-- 'httpStatus', 'deleteManagedEndpointResponse_httpStatus' - The response's http status code.
newDeleteManagedEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteManagedEndpointResponse
newDeleteManagedEndpointResponse :: Int -> DeleteManagedEndpointResponse
newDeleteManagedEndpointResponse Int
pHttpStatus_ =
  DeleteManagedEndpointResponse'
    { $sel:id:DeleteManagedEndpointResponse' :: Maybe Text
id =
        forall a. Maybe a
Prelude.Nothing,
      $sel:virtualClusterId:DeleteManagedEndpointResponse' :: Maybe Text
virtualClusterId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteManagedEndpointResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The output displays the ID of the managed endpoint.
deleteManagedEndpointResponse_id :: Lens.Lens' DeleteManagedEndpointResponse (Prelude.Maybe Prelude.Text)
deleteManagedEndpointResponse_id :: Lens' DeleteManagedEndpointResponse (Maybe Text)
deleteManagedEndpointResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteManagedEndpointResponse' {Maybe Text
id :: Maybe Text
$sel:id:DeleteManagedEndpointResponse' :: DeleteManagedEndpointResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: DeleteManagedEndpointResponse
s@DeleteManagedEndpointResponse' {} Maybe Text
a -> DeleteManagedEndpointResponse
s {$sel:id:DeleteManagedEndpointResponse' :: Maybe Text
id = Maybe Text
a} :: DeleteManagedEndpointResponse)

-- | The output displays the ID of the endpoint\'s virtual cluster.
deleteManagedEndpointResponse_virtualClusterId :: Lens.Lens' DeleteManagedEndpointResponse (Prelude.Maybe Prelude.Text)
deleteManagedEndpointResponse_virtualClusterId :: Lens' DeleteManagedEndpointResponse (Maybe Text)
deleteManagedEndpointResponse_virtualClusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteManagedEndpointResponse' {Maybe Text
virtualClusterId :: Maybe Text
$sel:virtualClusterId:DeleteManagedEndpointResponse' :: DeleteManagedEndpointResponse -> Maybe Text
virtualClusterId} -> Maybe Text
virtualClusterId) (\s :: DeleteManagedEndpointResponse
s@DeleteManagedEndpointResponse' {} Maybe Text
a -> DeleteManagedEndpointResponse
s {$sel:virtualClusterId:DeleteManagedEndpointResponse' :: Maybe Text
virtualClusterId = Maybe Text
a} :: DeleteManagedEndpointResponse)

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

instance Prelude.NFData DeleteManagedEndpointResponse where
  rnf :: DeleteManagedEndpointResponse -> ()
rnf DeleteManagedEndpointResponse' {Int
Maybe Text
httpStatus :: Int
virtualClusterId :: Maybe Text
id :: Maybe Text
$sel:httpStatus:DeleteManagedEndpointResponse' :: DeleteManagedEndpointResponse -> Int
$sel:virtualClusterId:DeleteManagedEndpointResponse' :: DeleteManagedEndpointResponse -> Maybe Text
$sel:id:DeleteManagedEndpointResponse' :: DeleteManagedEndpointResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
virtualClusterId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus