{-# 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.CloudSearch.DeleteIndexField
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes an @IndexField@ from the search domain. For more information,
-- see
-- <http://docs.aws.amazon.com/cloudsearch/latest/developerguide/configuring-index-fields.html Configuring Index Fields>
-- in the /Amazon CloudSearch Developer Guide/.
module Amazonka.CloudSearch.DeleteIndexField
  ( -- * Creating a Request
    DeleteIndexField (..),
    newDeleteIndexField,

    -- * Request Lenses
    deleteIndexField_domainName,
    deleteIndexField_indexFieldName,

    -- * Destructuring the Response
    DeleteIndexFieldResponse (..),
    newDeleteIndexFieldResponse,

    -- * Response Lenses
    deleteIndexFieldResponse_httpStatus,
    deleteIndexFieldResponse_indexField,
  )
where

import Amazonka.CloudSearch.Types
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

-- | Container for the parameters to the @DeleteIndexField@ operation.
-- Specifies the name of the domain you want to update and the name of the
-- index field you want to delete.
--
-- /See:/ 'newDeleteIndexField' smart constructor.
data DeleteIndexField = DeleteIndexField'
  { DeleteIndexField -> Text
domainName :: Prelude.Text,
    -- | The name of the index field your want to remove from the domain\'s
    -- indexing options.
    DeleteIndexField -> Text
indexFieldName :: Prelude.Text
  }
  deriving (DeleteIndexField -> DeleteIndexField -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteIndexField -> DeleteIndexField -> Bool
$c/= :: DeleteIndexField -> DeleteIndexField -> Bool
== :: DeleteIndexField -> DeleteIndexField -> Bool
$c== :: DeleteIndexField -> DeleteIndexField -> Bool
Prelude.Eq, ReadPrec [DeleteIndexField]
ReadPrec DeleteIndexField
Int -> ReadS DeleteIndexField
ReadS [DeleteIndexField]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteIndexField]
$creadListPrec :: ReadPrec [DeleteIndexField]
readPrec :: ReadPrec DeleteIndexField
$creadPrec :: ReadPrec DeleteIndexField
readList :: ReadS [DeleteIndexField]
$creadList :: ReadS [DeleteIndexField]
readsPrec :: Int -> ReadS DeleteIndexField
$creadsPrec :: Int -> ReadS DeleteIndexField
Prelude.Read, Int -> DeleteIndexField -> ShowS
[DeleteIndexField] -> ShowS
DeleteIndexField -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteIndexField] -> ShowS
$cshowList :: [DeleteIndexField] -> ShowS
show :: DeleteIndexField -> String
$cshow :: DeleteIndexField -> String
showsPrec :: Int -> DeleteIndexField -> ShowS
$cshowsPrec :: Int -> DeleteIndexField -> ShowS
Prelude.Show, forall x. Rep DeleteIndexField x -> DeleteIndexField
forall x. DeleteIndexField -> Rep DeleteIndexField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteIndexField x -> DeleteIndexField
$cfrom :: forall x. DeleteIndexField -> Rep DeleteIndexField x
Prelude.Generic)

-- |
-- Create a value of 'DeleteIndexField' 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:
--
-- 'domainName', 'deleteIndexField_domainName' - Undocumented member.
--
-- 'indexFieldName', 'deleteIndexField_indexFieldName' - The name of the index field your want to remove from the domain\'s
-- indexing options.
newDeleteIndexField ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'indexFieldName'
  Prelude.Text ->
  DeleteIndexField
newDeleteIndexField :: Text -> Text -> DeleteIndexField
newDeleteIndexField Text
pDomainName_ Text
pIndexFieldName_ =
  DeleteIndexField'
    { $sel:domainName:DeleteIndexField' :: Text
domainName = Text
pDomainName_,
      $sel:indexFieldName:DeleteIndexField' :: Text
indexFieldName = Text
pIndexFieldName_
    }

-- | Undocumented member.
deleteIndexField_domainName :: Lens.Lens' DeleteIndexField Prelude.Text
deleteIndexField_domainName :: Lens' DeleteIndexField Text
deleteIndexField_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIndexField' {Text
domainName :: Text
$sel:domainName:DeleteIndexField' :: DeleteIndexField -> Text
domainName} -> Text
domainName) (\s :: DeleteIndexField
s@DeleteIndexField' {} Text
a -> DeleteIndexField
s {$sel:domainName:DeleteIndexField' :: Text
domainName = Text
a} :: DeleteIndexField)

-- | The name of the index field your want to remove from the domain\'s
-- indexing options.
deleteIndexField_indexFieldName :: Lens.Lens' DeleteIndexField Prelude.Text
deleteIndexField_indexFieldName :: Lens' DeleteIndexField Text
deleteIndexField_indexFieldName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIndexField' {Text
indexFieldName :: Text
$sel:indexFieldName:DeleteIndexField' :: DeleteIndexField -> Text
indexFieldName} -> Text
indexFieldName) (\s :: DeleteIndexField
s@DeleteIndexField' {} Text
a -> DeleteIndexField
s {$sel:indexFieldName:DeleteIndexField' :: Text
indexFieldName = Text
a} :: DeleteIndexField)

instance Core.AWSRequest DeleteIndexField where
  type
    AWSResponse DeleteIndexField =
      DeleteIndexFieldResponse
  request :: (Service -> Service)
-> DeleteIndexField -> Request DeleteIndexField
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteIndexField
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteIndexField)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"DeleteIndexFieldResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> IndexFieldStatus -> DeleteIndexFieldResponse
DeleteIndexFieldResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"IndexField")
      )

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

instance Prelude.NFData DeleteIndexField where
  rnf :: DeleteIndexField -> ()
rnf DeleteIndexField' {Text
indexFieldName :: Text
domainName :: Text
$sel:indexFieldName:DeleteIndexField' :: DeleteIndexField -> Text
$sel:domainName:DeleteIndexField' :: DeleteIndexField -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
indexFieldName

instance Data.ToHeaders DeleteIndexField where
  toHeaders :: DeleteIndexField -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DeleteIndexField where
  toQuery :: DeleteIndexField -> QueryString
toQuery DeleteIndexField' {Text
indexFieldName :: Text
domainName :: Text
$sel:indexFieldName:DeleteIndexField' :: DeleteIndexField -> Text
$sel:domainName:DeleteIndexField' :: DeleteIndexField -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteIndexField" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2013-01-01" :: Prelude.ByteString),
        ByteString
"DomainName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
domainName,
        ByteString
"IndexFieldName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
indexFieldName
      ]

-- | The result of a @DeleteIndexField@ request.
--
-- /See:/ 'newDeleteIndexFieldResponse' smart constructor.
data DeleteIndexFieldResponse = DeleteIndexFieldResponse'
  { -- | The response's http status code.
    DeleteIndexFieldResponse -> Int
httpStatus :: Prelude.Int,
    -- | The status of the index field being deleted.
    DeleteIndexFieldResponse -> IndexFieldStatus
indexField :: IndexFieldStatus
  }
  deriving (DeleteIndexFieldResponse -> DeleteIndexFieldResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteIndexFieldResponse -> DeleteIndexFieldResponse -> Bool
$c/= :: DeleteIndexFieldResponse -> DeleteIndexFieldResponse -> Bool
== :: DeleteIndexFieldResponse -> DeleteIndexFieldResponse -> Bool
$c== :: DeleteIndexFieldResponse -> DeleteIndexFieldResponse -> Bool
Prelude.Eq, ReadPrec [DeleteIndexFieldResponse]
ReadPrec DeleteIndexFieldResponse
Int -> ReadS DeleteIndexFieldResponse
ReadS [DeleteIndexFieldResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteIndexFieldResponse]
$creadListPrec :: ReadPrec [DeleteIndexFieldResponse]
readPrec :: ReadPrec DeleteIndexFieldResponse
$creadPrec :: ReadPrec DeleteIndexFieldResponse
readList :: ReadS [DeleteIndexFieldResponse]
$creadList :: ReadS [DeleteIndexFieldResponse]
readsPrec :: Int -> ReadS DeleteIndexFieldResponse
$creadsPrec :: Int -> ReadS DeleteIndexFieldResponse
Prelude.Read, Int -> DeleteIndexFieldResponse -> ShowS
[DeleteIndexFieldResponse] -> ShowS
DeleteIndexFieldResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteIndexFieldResponse] -> ShowS
$cshowList :: [DeleteIndexFieldResponse] -> ShowS
show :: DeleteIndexFieldResponse -> String
$cshow :: DeleteIndexFieldResponse -> String
showsPrec :: Int -> DeleteIndexFieldResponse -> ShowS
$cshowsPrec :: Int -> DeleteIndexFieldResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteIndexFieldResponse x -> DeleteIndexFieldResponse
forall x.
DeleteIndexFieldResponse -> Rep DeleteIndexFieldResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteIndexFieldResponse x -> DeleteIndexFieldResponse
$cfrom :: forall x.
DeleteIndexFieldResponse -> Rep DeleteIndexFieldResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteIndexFieldResponse' 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:
--
-- 'httpStatus', 'deleteIndexFieldResponse_httpStatus' - The response's http status code.
--
-- 'indexField', 'deleteIndexFieldResponse_indexField' - The status of the index field being deleted.
newDeleteIndexFieldResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'indexField'
  IndexFieldStatus ->
  DeleteIndexFieldResponse
newDeleteIndexFieldResponse :: Int -> IndexFieldStatus -> DeleteIndexFieldResponse
newDeleteIndexFieldResponse Int
pHttpStatus_ IndexFieldStatus
pIndexField_ =
  DeleteIndexFieldResponse'
    { $sel:httpStatus:DeleteIndexFieldResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:indexField:DeleteIndexFieldResponse' :: IndexFieldStatus
indexField = IndexFieldStatus
pIndexField_
    }

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

-- | The status of the index field being deleted.
deleteIndexFieldResponse_indexField :: Lens.Lens' DeleteIndexFieldResponse IndexFieldStatus
deleteIndexFieldResponse_indexField :: Lens' DeleteIndexFieldResponse IndexFieldStatus
deleteIndexFieldResponse_indexField = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteIndexFieldResponse' {IndexFieldStatus
indexField :: IndexFieldStatus
$sel:indexField:DeleteIndexFieldResponse' :: DeleteIndexFieldResponse -> IndexFieldStatus
indexField} -> IndexFieldStatus
indexField) (\s :: DeleteIndexFieldResponse
s@DeleteIndexFieldResponse' {} IndexFieldStatus
a -> DeleteIndexFieldResponse
s {$sel:indexField:DeleteIndexFieldResponse' :: IndexFieldStatus
indexField = IndexFieldStatus
a} :: DeleteIndexFieldResponse)

instance Prelude.NFData DeleteIndexFieldResponse where
  rnf :: DeleteIndexFieldResponse -> ()
rnf DeleteIndexFieldResponse' {Int
IndexFieldStatus
indexField :: IndexFieldStatus
httpStatus :: Int
$sel:indexField:DeleteIndexFieldResponse' :: DeleteIndexFieldResponse -> IndexFieldStatus
$sel:httpStatus:DeleteIndexFieldResponse' :: DeleteIndexFieldResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf IndexFieldStatus
indexField