{-# 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.SageMaker.DeleteEndpointConfig
-- 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 an endpoint configuration. The @DeleteEndpointConfig@ API
-- deletes only the specified configuration. It does not delete endpoints
-- created using the configuration.
--
-- You must not delete an @EndpointConfig@ in use by an endpoint that is
-- live or while the @UpdateEndpoint@ or @CreateEndpoint@ operations are
-- being performed on the endpoint. If you delete the @EndpointConfig@ of
-- an endpoint that is active or being created or updated you may lose
-- visibility into the instance type the endpoint is using. The endpoint
-- must be deleted in order to stop incurring charges.
module Amazonka.SageMaker.DeleteEndpointConfig
  ( -- * Creating a Request
    DeleteEndpointConfig (..),
    newDeleteEndpointConfig,

    -- * Request Lenses
    deleteEndpointConfig_endpointConfigName,

    -- * Destructuring the Response
    DeleteEndpointConfigResponse (..),
    newDeleteEndpointConfigResponse,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SageMaker.Types

-- | /See:/ 'newDeleteEndpointConfig' smart constructor.
data DeleteEndpointConfig = DeleteEndpointConfig'
  { -- | The name of the endpoint configuration that you want to delete.
    DeleteEndpointConfig -> Text
endpointConfigName :: Prelude.Text
  }
  deriving (DeleteEndpointConfig -> DeleteEndpointConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteEndpointConfig -> DeleteEndpointConfig -> Bool
$c/= :: DeleteEndpointConfig -> DeleteEndpointConfig -> Bool
== :: DeleteEndpointConfig -> DeleteEndpointConfig -> Bool
$c== :: DeleteEndpointConfig -> DeleteEndpointConfig -> Bool
Prelude.Eq, ReadPrec [DeleteEndpointConfig]
ReadPrec DeleteEndpointConfig
Int -> ReadS DeleteEndpointConfig
ReadS [DeleteEndpointConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteEndpointConfig]
$creadListPrec :: ReadPrec [DeleteEndpointConfig]
readPrec :: ReadPrec DeleteEndpointConfig
$creadPrec :: ReadPrec DeleteEndpointConfig
readList :: ReadS [DeleteEndpointConfig]
$creadList :: ReadS [DeleteEndpointConfig]
readsPrec :: Int -> ReadS DeleteEndpointConfig
$creadsPrec :: Int -> ReadS DeleteEndpointConfig
Prelude.Read, Int -> DeleteEndpointConfig -> ShowS
[DeleteEndpointConfig] -> ShowS
DeleteEndpointConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteEndpointConfig] -> ShowS
$cshowList :: [DeleteEndpointConfig] -> ShowS
show :: DeleteEndpointConfig -> String
$cshow :: DeleteEndpointConfig -> String
showsPrec :: Int -> DeleteEndpointConfig -> ShowS
$cshowsPrec :: Int -> DeleteEndpointConfig -> ShowS
Prelude.Show, forall x. Rep DeleteEndpointConfig x -> DeleteEndpointConfig
forall x. DeleteEndpointConfig -> Rep DeleteEndpointConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteEndpointConfig x -> DeleteEndpointConfig
$cfrom :: forall x. DeleteEndpointConfig -> Rep DeleteEndpointConfig x
Prelude.Generic)

-- |
-- Create a value of 'DeleteEndpointConfig' 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:
--
-- 'endpointConfigName', 'deleteEndpointConfig_endpointConfigName' - The name of the endpoint configuration that you want to delete.
newDeleteEndpointConfig ::
  -- | 'endpointConfigName'
  Prelude.Text ->
  DeleteEndpointConfig
newDeleteEndpointConfig :: Text -> DeleteEndpointConfig
newDeleteEndpointConfig Text
pEndpointConfigName_ =
  DeleteEndpointConfig'
    { $sel:endpointConfigName:DeleteEndpointConfig' :: Text
endpointConfigName =
        Text
pEndpointConfigName_
    }

-- | The name of the endpoint configuration that you want to delete.
deleteEndpointConfig_endpointConfigName :: Lens.Lens' DeleteEndpointConfig Prelude.Text
deleteEndpointConfig_endpointConfigName :: Lens' DeleteEndpointConfig Text
deleteEndpointConfig_endpointConfigName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteEndpointConfig' {Text
endpointConfigName :: Text
$sel:endpointConfigName:DeleteEndpointConfig' :: DeleteEndpointConfig -> Text
endpointConfigName} -> Text
endpointConfigName) (\s :: DeleteEndpointConfig
s@DeleteEndpointConfig' {} Text
a -> DeleteEndpointConfig
s {$sel:endpointConfigName:DeleteEndpointConfig' :: Text
endpointConfigName = Text
a} :: DeleteEndpointConfig)

instance Core.AWSRequest DeleteEndpointConfig where
  type
    AWSResponse DeleteEndpointConfig =
      DeleteEndpointConfigResponse
  request :: (Service -> Service)
-> DeleteEndpointConfig -> Request DeleteEndpointConfig
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 DeleteEndpointConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteEndpointConfig)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteEndpointConfigResponse
DeleteEndpointConfigResponse'

instance Prelude.Hashable DeleteEndpointConfig where
  hashWithSalt :: Int -> DeleteEndpointConfig -> Int
hashWithSalt Int
_salt DeleteEndpointConfig' {Text
endpointConfigName :: Text
$sel:endpointConfigName:DeleteEndpointConfig' :: DeleteEndpointConfig -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointConfigName

instance Prelude.NFData DeleteEndpointConfig where
  rnf :: DeleteEndpointConfig -> ()
rnf DeleteEndpointConfig' {Text
endpointConfigName :: Text
$sel:endpointConfigName:DeleteEndpointConfig' :: DeleteEndpointConfig -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
endpointConfigName

instance Data.ToHeaders DeleteEndpointConfig where
  toHeaders :: DeleteEndpointConfig -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"SageMaker.DeleteEndpointConfig" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DeleteEndpointConfig where
  toJSON :: DeleteEndpointConfig -> Value
toJSON DeleteEndpointConfig' {Text
endpointConfigName :: Text
$sel:endpointConfigName:DeleteEndpointConfig' :: DeleteEndpointConfig -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"EndpointConfigName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
endpointConfigName)
          ]
      )

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

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

-- | /See:/ 'newDeleteEndpointConfigResponse' smart constructor.
data DeleteEndpointConfigResponse = DeleteEndpointConfigResponse'
  {
  }
  deriving (DeleteEndpointConfigResponse
-> DeleteEndpointConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteEndpointConfigResponse
-> DeleteEndpointConfigResponse -> Bool
$c/= :: DeleteEndpointConfigResponse
-> DeleteEndpointConfigResponse -> Bool
== :: DeleteEndpointConfigResponse
-> DeleteEndpointConfigResponse -> Bool
$c== :: DeleteEndpointConfigResponse
-> DeleteEndpointConfigResponse -> Bool
Prelude.Eq, ReadPrec [DeleteEndpointConfigResponse]
ReadPrec DeleteEndpointConfigResponse
Int -> ReadS DeleteEndpointConfigResponse
ReadS [DeleteEndpointConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteEndpointConfigResponse]
$creadListPrec :: ReadPrec [DeleteEndpointConfigResponse]
readPrec :: ReadPrec DeleteEndpointConfigResponse
$creadPrec :: ReadPrec DeleteEndpointConfigResponse
readList :: ReadS [DeleteEndpointConfigResponse]
$creadList :: ReadS [DeleteEndpointConfigResponse]
readsPrec :: Int -> ReadS DeleteEndpointConfigResponse
$creadsPrec :: Int -> ReadS DeleteEndpointConfigResponse
Prelude.Read, Int -> DeleteEndpointConfigResponse -> ShowS
[DeleteEndpointConfigResponse] -> ShowS
DeleteEndpointConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteEndpointConfigResponse] -> ShowS
$cshowList :: [DeleteEndpointConfigResponse] -> ShowS
show :: DeleteEndpointConfigResponse -> String
$cshow :: DeleteEndpointConfigResponse -> String
showsPrec :: Int -> DeleteEndpointConfigResponse -> ShowS
$cshowsPrec :: Int -> DeleteEndpointConfigResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteEndpointConfigResponse x -> DeleteEndpointConfigResponse
forall x.
DeleteEndpointConfigResponse -> Rep DeleteEndpointConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteEndpointConfigResponse x -> DeleteEndpointConfigResponse
$cfrom :: forall x.
DeleteEndpointConfigResponse -> Rep DeleteEndpointConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteEndpointConfigResponse' 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.
newDeleteEndpointConfigResponse ::
  DeleteEndpointConfigResponse
newDeleteEndpointConfigResponse :: DeleteEndpointConfigResponse
newDeleteEndpointConfigResponse =
  DeleteEndpointConfigResponse
DeleteEndpointConfigResponse'

instance Prelude.NFData DeleteEndpointConfigResponse where
  rnf :: DeleteEndpointConfigResponse -> ()
rnf DeleteEndpointConfigResponse
_ = ()