{-# 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.DeleteFeatureGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Delete the @FeatureGroup@ and any data that was written to the
-- @OnlineStore@ of the @FeatureGroup@. Data cannot be accessed from the
-- @OnlineStore@ immediately after @DeleteFeatureGroup@ is called.
--
-- Data written into the @OfflineStore@ will not be deleted. The Amazon Web
-- Services Glue database and tables that are automatically created for
-- your @OfflineStore@ are not deleted.
module Amazonka.SageMaker.DeleteFeatureGroup
  ( -- * Creating a Request
    DeleteFeatureGroup (..),
    newDeleteFeatureGroup,

    -- * Request Lenses
    deleteFeatureGroup_featureGroupName,

    -- * Destructuring the Response
    DeleteFeatureGroupResponse (..),
    newDeleteFeatureGroupResponse,
  )
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:/ 'newDeleteFeatureGroup' smart constructor.
data DeleteFeatureGroup = DeleteFeatureGroup'
  { -- | The name of the @FeatureGroup@ you want to delete. The name must be
    -- unique within an Amazon Web Services Region in an Amazon Web Services
    -- account.
    DeleteFeatureGroup -> Text
featureGroupName :: Prelude.Text
  }
  deriving (DeleteFeatureGroup -> DeleteFeatureGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteFeatureGroup -> DeleteFeatureGroup -> Bool
$c/= :: DeleteFeatureGroup -> DeleteFeatureGroup -> Bool
== :: DeleteFeatureGroup -> DeleteFeatureGroup -> Bool
$c== :: DeleteFeatureGroup -> DeleteFeatureGroup -> Bool
Prelude.Eq, ReadPrec [DeleteFeatureGroup]
ReadPrec DeleteFeatureGroup
Int -> ReadS DeleteFeatureGroup
ReadS [DeleteFeatureGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteFeatureGroup]
$creadListPrec :: ReadPrec [DeleteFeatureGroup]
readPrec :: ReadPrec DeleteFeatureGroup
$creadPrec :: ReadPrec DeleteFeatureGroup
readList :: ReadS [DeleteFeatureGroup]
$creadList :: ReadS [DeleteFeatureGroup]
readsPrec :: Int -> ReadS DeleteFeatureGroup
$creadsPrec :: Int -> ReadS DeleteFeatureGroup
Prelude.Read, Int -> DeleteFeatureGroup -> ShowS
[DeleteFeatureGroup] -> ShowS
DeleteFeatureGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteFeatureGroup] -> ShowS
$cshowList :: [DeleteFeatureGroup] -> ShowS
show :: DeleteFeatureGroup -> String
$cshow :: DeleteFeatureGroup -> String
showsPrec :: Int -> DeleteFeatureGroup -> ShowS
$cshowsPrec :: Int -> DeleteFeatureGroup -> ShowS
Prelude.Show, forall x. Rep DeleteFeatureGroup x -> DeleteFeatureGroup
forall x. DeleteFeatureGroup -> Rep DeleteFeatureGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteFeatureGroup x -> DeleteFeatureGroup
$cfrom :: forall x. DeleteFeatureGroup -> Rep DeleteFeatureGroup x
Prelude.Generic)

-- |
-- Create a value of 'DeleteFeatureGroup' 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:
--
-- 'featureGroupName', 'deleteFeatureGroup_featureGroupName' - The name of the @FeatureGroup@ you want to delete. The name must be
-- unique within an Amazon Web Services Region in an Amazon Web Services
-- account.
newDeleteFeatureGroup ::
  -- | 'featureGroupName'
  Prelude.Text ->
  DeleteFeatureGroup
newDeleteFeatureGroup :: Text -> DeleteFeatureGroup
newDeleteFeatureGroup Text
pFeatureGroupName_ =
  DeleteFeatureGroup'
    { $sel:featureGroupName:DeleteFeatureGroup' :: Text
featureGroupName =
        Text
pFeatureGroupName_
    }

-- | The name of the @FeatureGroup@ you want to delete. The name must be
-- unique within an Amazon Web Services Region in an Amazon Web Services
-- account.
deleteFeatureGroup_featureGroupName :: Lens.Lens' DeleteFeatureGroup Prelude.Text
deleteFeatureGroup_featureGroupName :: Lens' DeleteFeatureGroup Text
deleteFeatureGroup_featureGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteFeatureGroup' {Text
featureGroupName :: Text
$sel:featureGroupName:DeleteFeatureGroup' :: DeleteFeatureGroup -> Text
featureGroupName} -> Text
featureGroupName) (\s :: DeleteFeatureGroup
s@DeleteFeatureGroup' {} Text
a -> DeleteFeatureGroup
s {$sel:featureGroupName:DeleteFeatureGroup' :: Text
featureGroupName = Text
a} :: DeleteFeatureGroup)

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

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

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

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

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

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

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

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

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