{-# 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.DeleteHubContent
-- 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 contents of a hub.
module Amazonka.SageMaker.DeleteHubContent
  ( -- * Creating a Request
    DeleteHubContent (..),
    newDeleteHubContent,

    -- * Request Lenses
    deleteHubContent_hubName,
    deleteHubContent_hubContentType,
    deleteHubContent_hubContentName,
    deleteHubContent_hubContentVersion,

    -- * Destructuring the Response
    DeleteHubContentResponse (..),
    newDeleteHubContentResponse,
  )
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:/ 'newDeleteHubContent' smart constructor.
data DeleteHubContent = DeleteHubContent'
  { -- | The name of the hub that you want to delete content in.
    DeleteHubContent -> Text
hubName :: Prelude.Text,
    -- | The type of content that you want to delete from a hub.
    DeleteHubContent -> HubContentType
hubContentType :: HubContentType,
    -- | The name of the content that you want to delete from a hub.
    DeleteHubContent -> Text
hubContentName :: Prelude.Text,
    -- | The version of the content that you want to delete from a hub.
    DeleteHubContent -> Text
hubContentVersion :: Prelude.Text
  }
  deriving (DeleteHubContent -> DeleteHubContent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteHubContent -> DeleteHubContent -> Bool
$c/= :: DeleteHubContent -> DeleteHubContent -> Bool
== :: DeleteHubContent -> DeleteHubContent -> Bool
$c== :: DeleteHubContent -> DeleteHubContent -> Bool
Prelude.Eq, ReadPrec [DeleteHubContent]
ReadPrec DeleteHubContent
Int -> ReadS DeleteHubContent
ReadS [DeleteHubContent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteHubContent]
$creadListPrec :: ReadPrec [DeleteHubContent]
readPrec :: ReadPrec DeleteHubContent
$creadPrec :: ReadPrec DeleteHubContent
readList :: ReadS [DeleteHubContent]
$creadList :: ReadS [DeleteHubContent]
readsPrec :: Int -> ReadS DeleteHubContent
$creadsPrec :: Int -> ReadS DeleteHubContent
Prelude.Read, Int -> DeleteHubContent -> ShowS
[DeleteHubContent] -> ShowS
DeleteHubContent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteHubContent] -> ShowS
$cshowList :: [DeleteHubContent] -> ShowS
show :: DeleteHubContent -> String
$cshow :: DeleteHubContent -> String
showsPrec :: Int -> DeleteHubContent -> ShowS
$cshowsPrec :: Int -> DeleteHubContent -> ShowS
Prelude.Show, forall x. Rep DeleteHubContent x -> DeleteHubContent
forall x. DeleteHubContent -> Rep DeleteHubContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteHubContent x -> DeleteHubContent
$cfrom :: forall x. DeleteHubContent -> Rep DeleteHubContent x
Prelude.Generic)

-- |
-- Create a value of 'DeleteHubContent' 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:
--
-- 'hubName', 'deleteHubContent_hubName' - The name of the hub that you want to delete content in.
--
-- 'hubContentType', 'deleteHubContent_hubContentType' - The type of content that you want to delete from a hub.
--
-- 'hubContentName', 'deleteHubContent_hubContentName' - The name of the content that you want to delete from a hub.
--
-- 'hubContentVersion', 'deleteHubContent_hubContentVersion' - The version of the content that you want to delete from a hub.
newDeleteHubContent ::
  -- | 'hubName'
  Prelude.Text ->
  -- | 'hubContentType'
  HubContentType ->
  -- | 'hubContentName'
  Prelude.Text ->
  -- | 'hubContentVersion'
  Prelude.Text ->
  DeleteHubContent
newDeleteHubContent :: Text -> HubContentType -> Text -> Text -> DeleteHubContent
newDeleteHubContent
  Text
pHubName_
  HubContentType
pHubContentType_
  Text
pHubContentName_
  Text
pHubContentVersion_ =
    DeleteHubContent'
      { $sel:hubName:DeleteHubContent' :: Text
hubName = Text
pHubName_,
        $sel:hubContentType:DeleteHubContent' :: HubContentType
hubContentType = HubContentType
pHubContentType_,
        $sel:hubContentName:DeleteHubContent' :: Text
hubContentName = Text
pHubContentName_,
        $sel:hubContentVersion:DeleteHubContent' :: Text
hubContentVersion = Text
pHubContentVersion_
      }

-- | The name of the hub that you want to delete content in.
deleteHubContent_hubName :: Lens.Lens' DeleteHubContent Prelude.Text
deleteHubContent_hubName :: Lens' DeleteHubContent Text
deleteHubContent_hubName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteHubContent' {Text
hubName :: Text
$sel:hubName:DeleteHubContent' :: DeleteHubContent -> Text
hubName} -> Text
hubName) (\s :: DeleteHubContent
s@DeleteHubContent' {} Text
a -> DeleteHubContent
s {$sel:hubName:DeleteHubContent' :: Text
hubName = Text
a} :: DeleteHubContent)

-- | The type of content that you want to delete from a hub.
deleteHubContent_hubContentType :: Lens.Lens' DeleteHubContent HubContentType
deleteHubContent_hubContentType :: Lens' DeleteHubContent HubContentType
deleteHubContent_hubContentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteHubContent' {HubContentType
hubContentType :: HubContentType
$sel:hubContentType:DeleteHubContent' :: DeleteHubContent -> HubContentType
hubContentType} -> HubContentType
hubContentType) (\s :: DeleteHubContent
s@DeleteHubContent' {} HubContentType
a -> DeleteHubContent
s {$sel:hubContentType:DeleteHubContent' :: HubContentType
hubContentType = HubContentType
a} :: DeleteHubContent)

-- | The name of the content that you want to delete from a hub.
deleteHubContent_hubContentName :: Lens.Lens' DeleteHubContent Prelude.Text
deleteHubContent_hubContentName :: Lens' DeleteHubContent Text
deleteHubContent_hubContentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteHubContent' {Text
hubContentName :: Text
$sel:hubContentName:DeleteHubContent' :: DeleteHubContent -> Text
hubContentName} -> Text
hubContentName) (\s :: DeleteHubContent
s@DeleteHubContent' {} Text
a -> DeleteHubContent
s {$sel:hubContentName:DeleteHubContent' :: Text
hubContentName = Text
a} :: DeleteHubContent)

-- | The version of the content that you want to delete from a hub.
deleteHubContent_hubContentVersion :: Lens.Lens' DeleteHubContent Prelude.Text
deleteHubContent_hubContentVersion :: Lens' DeleteHubContent Text
deleteHubContent_hubContentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteHubContent' {Text
hubContentVersion :: Text
$sel:hubContentVersion:DeleteHubContent' :: DeleteHubContent -> Text
hubContentVersion} -> Text
hubContentVersion) (\s :: DeleteHubContent
s@DeleteHubContent' {} Text
a -> DeleteHubContent
s {$sel:hubContentVersion:DeleteHubContent' :: Text
hubContentVersion = Text
a} :: DeleteHubContent)

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

instance Prelude.Hashable DeleteHubContent where
  hashWithSalt :: Int -> DeleteHubContent -> Int
hashWithSalt Int
_salt DeleteHubContent' {Text
HubContentType
hubContentVersion :: Text
hubContentName :: Text
hubContentType :: HubContentType
hubName :: Text
$sel:hubContentVersion:DeleteHubContent' :: DeleteHubContent -> Text
$sel:hubContentName:DeleteHubContent' :: DeleteHubContent -> Text
$sel:hubContentType:DeleteHubContent' :: DeleteHubContent -> HubContentType
$sel:hubName:DeleteHubContent' :: DeleteHubContent -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hubName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HubContentType
hubContentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hubContentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hubContentVersion

instance Prelude.NFData DeleteHubContent where
  rnf :: DeleteHubContent -> ()
rnf DeleteHubContent' {Text
HubContentType
hubContentVersion :: Text
hubContentName :: Text
hubContentType :: HubContentType
hubName :: Text
$sel:hubContentVersion:DeleteHubContent' :: DeleteHubContent -> Text
$sel:hubContentName:DeleteHubContent' :: DeleteHubContent -> Text
$sel:hubContentType:DeleteHubContent' :: DeleteHubContent -> HubContentType
$sel:hubName:DeleteHubContent' :: DeleteHubContent -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
hubName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HubContentType
hubContentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hubContentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hubContentVersion

instance Data.ToHeaders DeleteHubContent where
  toHeaders :: DeleteHubContent -> [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.DeleteHubContent" :: 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 DeleteHubContent where
  toJSON :: DeleteHubContent -> Value
toJSON DeleteHubContent' {Text
HubContentType
hubContentVersion :: Text
hubContentName :: Text
hubContentType :: HubContentType
hubName :: Text
$sel:hubContentVersion:DeleteHubContent' :: DeleteHubContent -> Text
$sel:hubContentName:DeleteHubContent' :: DeleteHubContent -> Text
$sel:hubContentType:DeleteHubContent' :: DeleteHubContent -> HubContentType
$sel:hubName:DeleteHubContent' :: DeleteHubContent -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"HubName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hubName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"HubContentType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HubContentType
hubContentType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"HubContentName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hubContentName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"HubContentVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hubContentVersion)
          ]
      )

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

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

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

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

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