{-# 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.DeleteNotebookInstance
-- 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 SageMaker notebook instance. Before you can delete a notebook
-- instance, you must call the @StopNotebookInstance@ API.
--
-- When you delete a notebook instance, you lose all of your data.
-- SageMaker removes the ML compute instance, and deletes the ML storage
-- volume and the network interface associated with the notebook instance.
module Amazonka.SageMaker.DeleteNotebookInstance
  ( -- * Creating a Request
    DeleteNotebookInstance (..),
    newDeleteNotebookInstance,

    -- * Request Lenses
    deleteNotebookInstance_notebookInstanceName,

    -- * Destructuring the Response
    DeleteNotebookInstanceResponse (..),
    newDeleteNotebookInstanceResponse,
  )
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:/ 'newDeleteNotebookInstance' smart constructor.
data DeleteNotebookInstance = DeleteNotebookInstance'
  { -- | The name of the SageMaker notebook instance to delete.
    DeleteNotebookInstance -> Text
notebookInstanceName :: Prelude.Text
  }
  deriving (DeleteNotebookInstance -> DeleteNotebookInstance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteNotebookInstance -> DeleteNotebookInstance -> Bool
$c/= :: DeleteNotebookInstance -> DeleteNotebookInstance -> Bool
== :: DeleteNotebookInstance -> DeleteNotebookInstance -> Bool
$c== :: DeleteNotebookInstance -> DeleteNotebookInstance -> Bool
Prelude.Eq, ReadPrec [DeleteNotebookInstance]
ReadPrec DeleteNotebookInstance
Int -> ReadS DeleteNotebookInstance
ReadS [DeleteNotebookInstance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteNotebookInstance]
$creadListPrec :: ReadPrec [DeleteNotebookInstance]
readPrec :: ReadPrec DeleteNotebookInstance
$creadPrec :: ReadPrec DeleteNotebookInstance
readList :: ReadS [DeleteNotebookInstance]
$creadList :: ReadS [DeleteNotebookInstance]
readsPrec :: Int -> ReadS DeleteNotebookInstance
$creadsPrec :: Int -> ReadS DeleteNotebookInstance
Prelude.Read, Int -> DeleteNotebookInstance -> ShowS
[DeleteNotebookInstance] -> ShowS
DeleteNotebookInstance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteNotebookInstance] -> ShowS
$cshowList :: [DeleteNotebookInstance] -> ShowS
show :: DeleteNotebookInstance -> String
$cshow :: DeleteNotebookInstance -> String
showsPrec :: Int -> DeleteNotebookInstance -> ShowS
$cshowsPrec :: Int -> DeleteNotebookInstance -> ShowS
Prelude.Show, forall x. Rep DeleteNotebookInstance x -> DeleteNotebookInstance
forall x. DeleteNotebookInstance -> Rep DeleteNotebookInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteNotebookInstance x -> DeleteNotebookInstance
$cfrom :: forall x. DeleteNotebookInstance -> Rep DeleteNotebookInstance x
Prelude.Generic)

-- |
-- Create a value of 'DeleteNotebookInstance' 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:
--
-- 'notebookInstanceName', 'deleteNotebookInstance_notebookInstanceName' - The name of the SageMaker notebook instance to delete.
newDeleteNotebookInstance ::
  -- | 'notebookInstanceName'
  Prelude.Text ->
  DeleteNotebookInstance
newDeleteNotebookInstance :: Text -> DeleteNotebookInstance
newDeleteNotebookInstance Text
pNotebookInstanceName_ =
  DeleteNotebookInstance'
    { $sel:notebookInstanceName:DeleteNotebookInstance' :: Text
notebookInstanceName =
        Text
pNotebookInstanceName_
    }

-- | The name of the SageMaker notebook instance to delete.
deleteNotebookInstance_notebookInstanceName :: Lens.Lens' DeleteNotebookInstance Prelude.Text
deleteNotebookInstance_notebookInstanceName :: Lens' DeleteNotebookInstance Text
deleteNotebookInstance_notebookInstanceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteNotebookInstance' {Text
notebookInstanceName :: Text
$sel:notebookInstanceName:DeleteNotebookInstance' :: DeleteNotebookInstance -> Text
notebookInstanceName} -> Text
notebookInstanceName) (\s :: DeleteNotebookInstance
s@DeleteNotebookInstance' {} Text
a -> DeleteNotebookInstance
s {$sel:notebookInstanceName:DeleteNotebookInstance' :: Text
notebookInstanceName = Text
a} :: DeleteNotebookInstance)

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

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

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

instance Data.ToHeaders DeleteNotebookInstance where
  toHeaders :: DeleteNotebookInstance -> [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.DeleteNotebookInstance" ::
                          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 DeleteNotebookInstance where
  toJSON :: DeleteNotebookInstance -> Value
toJSON DeleteNotebookInstance' {Text
notebookInstanceName :: Text
$sel:notebookInstanceName:DeleteNotebookInstance' :: DeleteNotebookInstance -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"NotebookInstanceName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
notebookInstanceName
              )
          ]
      )

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

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

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

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

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