{-# 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.Kendra.DeleteIndex
-- 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 existing Amazon Kendra index. An exception is not thrown if
-- the index is already being deleted. While the index is being deleted,
-- the @Status@ field returned by a call to the @DescribeIndex@ API is set
-- to @DELETING@.
module Amazonka.Kendra.DeleteIndex
  ( -- * Creating a Request
    DeleteIndex (..),
    newDeleteIndex,

    -- * Request Lenses
    deleteIndex_id,

    -- * Destructuring the Response
    DeleteIndexResponse (..),
    newDeleteIndexResponse,
  )
where

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

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

-- |
-- Create a value of 'DeleteIndex' 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:
--
-- 'id', 'deleteIndex_id' - The identifier of the index you want to delete.
newDeleteIndex ::
  -- | 'id'
  Prelude.Text ->
  DeleteIndex
newDeleteIndex :: Text -> DeleteIndex
newDeleteIndex Text
pId_ = DeleteIndex' {$sel:id:DeleteIndex' :: Text
id = Text
pId_}

-- | The identifier of the index you want to delete.
deleteIndex_id :: Lens.Lens' DeleteIndex Prelude.Text
deleteIndex_id :: Lens' DeleteIndex Text
deleteIndex_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIndex' {Text
id :: Text
$sel:id:DeleteIndex' :: DeleteIndex -> Text
id} -> Text
id) (\s :: DeleteIndex
s@DeleteIndex' {} Text
a -> DeleteIndex
s {$sel:id:DeleteIndex' :: Text
id = Text
a} :: DeleteIndex)

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

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

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

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

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

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

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

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

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