{-# 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.LexModels.DeleteBot
-- 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 all versions of the bot, including the @$LATEST@ version. To
-- delete a specific version of the bot, use the DeleteBotVersion
-- operation. The @DeleteBot@ operation doesn\'t immediately remove the bot
-- schema. Instead, it is marked for deletion and removed later.
--
-- Amazon Lex stores utterances indefinitely for improving the ability of
-- your bot to respond to user inputs. These utterances are not removed
-- when the bot is deleted. To remove the utterances, use the
-- DeleteUtterances operation.
--
-- If a bot has an alias, you can\'t delete it. Instead, the @DeleteBot@
-- operation returns a @ResourceInUseException@ exception that includes a
-- reference to the alias that refers to the bot. To remove the reference
-- to the bot, delete the alias. If you get the same exception again,
-- delete the referring alias until the @DeleteBot@ operation is
-- successful.
--
-- This operation requires permissions for the @lex:DeleteBot@ action.
module Amazonka.LexModels.DeleteBot
  ( -- * Creating a Request
    DeleteBot (..),
    newDeleteBot,

    -- * Request Lenses
    deleteBot_name,

    -- * Destructuring the Response
    DeleteBotResponse (..),
    newDeleteBotResponse,
  )
where

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

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

-- |
-- Create a value of 'DeleteBot' 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:
--
-- 'name', 'deleteBot_name' - The name of the bot. The name is case sensitive.
newDeleteBot ::
  -- | 'name'
  Prelude.Text ->
  DeleteBot
newDeleteBot :: Text -> DeleteBot
newDeleteBot Text
pName_ = DeleteBot' {$sel:name:DeleteBot' :: Text
name = Text
pName_}

-- | The name of the bot. The name is case sensitive.
deleteBot_name :: Lens.Lens' DeleteBot Prelude.Text
deleteBot_name :: Lens' DeleteBot Text
deleteBot_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteBot' {Text
name :: Text
$sel:name:DeleteBot' :: DeleteBot -> Text
name} -> Text
name) (\s :: DeleteBot
s@DeleteBot' {} Text
a -> DeleteBot
s {$sel:name:DeleteBot' :: Text
name = Text
a} :: DeleteBot)

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

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

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

instance Data.ToHeaders DeleteBot where
  toHeaders :: DeleteBot -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DeleteBot where
  toPath :: DeleteBot -> ByteString
toPath DeleteBot' {Text
name :: Text
$sel:name:DeleteBot' :: DeleteBot -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/bots/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

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

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

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

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