{-# 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.ResourceExplorer2.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 the specified index and turns off Amazon Web Services Resource
-- Explorer in the specified Amazon Web Services Region. When you delete an
-- index, Resource Explorer stops discovering and indexing resources in
-- that Region. Resource Explorer also deletes all views in that Region.
-- These actions occur as asynchronous background tasks. You can check to
-- see when the actions are complete by using the GetIndex operation and
-- checking the @Status@ response value.
--
-- If the index you delete is the aggregator index for the Amazon Web
-- Services account, you must wait 24 hours before you can promote another
-- local index to be the aggregator index for the account. Users can\'t
-- perform account-wide searches using Resource Explorer until another
-- aggregator index is configured.
module Amazonka.ResourceExplorer2.DeleteIndex
  ( -- * Creating a Request
    DeleteIndex (..),
    newDeleteIndex,

    -- * Request Lenses
    deleteIndex_arn,

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

    -- * Response Lenses
    deleteIndexResponse_arn,
    deleteIndexResponse_lastUpdatedAt,
    deleteIndexResponse_state,
    deleteIndexResponse_httpStatus,
  )
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 Amazonka.ResourceExplorer2.Types
import qualified Amazonka.Response as Response

-- | /See:/ 'newDeleteIndex' smart constructor.
data DeleteIndex = DeleteIndex'
  { -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon resource name (ARN)>
    -- of the index that you want to delete.
    DeleteIndex -> Text
arn :: 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:
--
-- 'arn', 'deleteIndex_arn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon resource name (ARN)>
-- of the index that you want to delete.
newDeleteIndex ::
  -- | 'arn'
  Prelude.Text ->
  DeleteIndex
newDeleteIndex :: Text -> DeleteIndex
newDeleteIndex Text
pArn_ = DeleteIndex' {$sel:arn:DeleteIndex' :: Text
arn = Text
pArn_}

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon resource name (ARN)>
-- of the index that you want to delete.
deleteIndex_arn :: Lens.Lens' DeleteIndex Prelude.Text
deleteIndex_arn :: Lens' DeleteIndex Text
deleteIndex_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIndex' {Text
arn :: Text
$sel:arn:DeleteIndex' :: DeleteIndex -> Text
arn} -> Text
arn) (\s :: DeleteIndex
s@DeleteIndex' {} Text
a -> DeleteIndex
s {$sel:arn:DeleteIndex' :: Text
arn = 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 =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe ISO8601 -> Maybe IndexState -> Int -> DeleteIndexResponse
DeleteIndexResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LastUpdatedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"State")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

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

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

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

instance Data.ToJSON DeleteIndex where
  toJSON :: DeleteIndex -> Value
toJSON DeleteIndex' {Text
arn :: Text
$sel:arn:DeleteIndex' :: DeleteIndex -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"Arn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
arn)]
      )

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

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'
  { -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon resource name (ARN)>
    -- of the index that you successfully started the deletion process.
    --
    -- This operation is asynchronous. To check its status, call the GetIndex
    -- operation.
    DeleteIndexResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The date and time when you last updated this index.
    DeleteIndexResponse -> Maybe ISO8601
lastUpdatedAt :: Prelude.Maybe Data.ISO8601,
    -- | Indicates the current state of the index.
    DeleteIndexResponse -> Maybe IndexState
state :: Prelude.Maybe IndexState,
    -- | The response's http status code.
    DeleteIndexResponse -> Int
httpStatus :: Prelude.Int
  }
  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.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'arn', 'deleteIndexResponse_arn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon resource name (ARN)>
-- of the index that you successfully started the deletion process.
--
-- This operation is asynchronous. To check its status, call the GetIndex
-- operation.
--
-- 'lastUpdatedAt', 'deleteIndexResponse_lastUpdatedAt' - The date and time when you last updated this index.
--
-- 'state', 'deleteIndexResponse_state' - Indicates the current state of the index.
--
-- 'httpStatus', 'deleteIndexResponse_httpStatus' - The response's http status code.
newDeleteIndexResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteIndexResponse
newDeleteIndexResponse :: Int -> DeleteIndexResponse
newDeleteIndexResponse Int
pHttpStatus_ =
  DeleteIndexResponse'
    { $sel:arn:DeleteIndexResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedAt:DeleteIndexResponse' :: Maybe ISO8601
lastUpdatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:state:DeleteIndexResponse' :: Maybe IndexState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteIndexResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon resource name (ARN)>
-- of the index that you successfully started the deletion process.
--
-- This operation is asynchronous. To check its status, call the GetIndex
-- operation.
deleteIndexResponse_arn :: Lens.Lens' DeleteIndexResponse (Prelude.Maybe Prelude.Text)
deleteIndexResponse_arn :: Lens' DeleteIndexResponse (Maybe Text)
deleteIndexResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIndexResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:DeleteIndexResponse' :: DeleteIndexResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: DeleteIndexResponse
s@DeleteIndexResponse' {} Maybe Text
a -> DeleteIndexResponse
s {$sel:arn:DeleteIndexResponse' :: Maybe Text
arn = Maybe Text
a} :: DeleteIndexResponse)

-- | The date and time when you last updated this index.
deleteIndexResponse_lastUpdatedAt :: Lens.Lens' DeleteIndexResponse (Prelude.Maybe Prelude.UTCTime)
deleteIndexResponse_lastUpdatedAt :: Lens' DeleteIndexResponse (Maybe UTCTime)
deleteIndexResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIndexResponse' {Maybe ISO8601
lastUpdatedAt :: Maybe ISO8601
$sel:lastUpdatedAt:DeleteIndexResponse' :: DeleteIndexResponse -> Maybe ISO8601
lastUpdatedAt} -> Maybe ISO8601
lastUpdatedAt) (\s :: DeleteIndexResponse
s@DeleteIndexResponse' {} Maybe ISO8601
a -> DeleteIndexResponse
s {$sel:lastUpdatedAt:DeleteIndexResponse' :: Maybe ISO8601
lastUpdatedAt = Maybe ISO8601
a} :: DeleteIndexResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Indicates the current state of the index.
deleteIndexResponse_state :: Lens.Lens' DeleteIndexResponse (Prelude.Maybe IndexState)
deleteIndexResponse_state :: Lens' DeleteIndexResponse (Maybe IndexState)
deleteIndexResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIndexResponse' {Maybe IndexState
state :: Maybe IndexState
$sel:state:DeleteIndexResponse' :: DeleteIndexResponse -> Maybe IndexState
state} -> Maybe IndexState
state) (\s :: DeleteIndexResponse
s@DeleteIndexResponse' {} Maybe IndexState
a -> DeleteIndexResponse
s {$sel:state:DeleteIndexResponse' :: Maybe IndexState
state = Maybe IndexState
a} :: DeleteIndexResponse)

-- | The response's http status code.
deleteIndexResponse_httpStatus :: Lens.Lens' DeleteIndexResponse Prelude.Int
deleteIndexResponse_httpStatus :: Lens' DeleteIndexResponse Int
deleteIndexResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIndexResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteIndexResponse' :: DeleteIndexResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DeleteIndexResponse
s@DeleteIndexResponse' {} Int
a -> DeleteIndexResponse
s {$sel:httpStatus:DeleteIndexResponse' :: Int
httpStatus = Int
a} :: DeleteIndexResponse)

instance Prelude.NFData DeleteIndexResponse where
  rnf :: DeleteIndexResponse -> ()
rnf DeleteIndexResponse' {Int
Maybe Text
Maybe ISO8601
Maybe IndexState
httpStatus :: Int
state :: Maybe IndexState
lastUpdatedAt :: Maybe ISO8601
arn :: Maybe Text
$sel:httpStatus:DeleteIndexResponse' :: DeleteIndexResponse -> Int
$sel:state:DeleteIndexResponse' :: DeleteIndexResponse -> Maybe IndexState
$sel:lastUpdatedAt:DeleteIndexResponse' :: DeleteIndexResponse -> Maybe ISO8601
$sel:arn:DeleteIndexResponse' :: DeleteIndexResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
lastUpdatedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IndexState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus