{-# 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.ElasticSearch.RemoveTags
-- 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 the specified set of tags from the specified Elasticsearch
-- domain.
module Amazonka.ElasticSearch.RemoveTags
  ( -- * Creating a Request
    RemoveTags (..),
    newRemoveTags,

    -- * Request Lenses
    removeTags_arn,
    removeTags_tagKeys,

    -- * Destructuring the Response
    RemoveTagsResponse (..),
    newRemoveTagsResponse,
  )
where

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

-- | Container for the parameters to the @RemoveTags@ operation. Specify the
-- @ARN@ for the Elasticsearch domain from which you want to remove the
-- specified @TagKey@.
--
-- /See:/ 'newRemoveTags' smart constructor.
data RemoveTags = RemoveTags'
  { -- | Specifies the @ARN@ for the Elasticsearch domain from which you want to
    -- delete the specified tags.
    RemoveTags -> Text
arn :: Prelude.Text,
    -- | Specifies the @TagKey@ list which you want to remove from the
    -- Elasticsearch domain.
    RemoveTags -> [Text]
tagKeys :: [Prelude.Text]
  }
  deriving (RemoveTags -> RemoveTags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoveTags -> RemoveTags -> Bool
$c/= :: RemoveTags -> RemoveTags -> Bool
== :: RemoveTags -> RemoveTags -> Bool
$c== :: RemoveTags -> RemoveTags -> Bool
Prelude.Eq, ReadPrec [RemoveTags]
ReadPrec RemoveTags
Int -> ReadS RemoveTags
ReadS [RemoveTags]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemoveTags]
$creadListPrec :: ReadPrec [RemoveTags]
readPrec :: ReadPrec RemoveTags
$creadPrec :: ReadPrec RemoveTags
readList :: ReadS [RemoveTags]
$creadList :: ReadS [RemoveTags]
readsPrec :: Int -> ReadS RemoveTags
$creadsPrec :: Int -> ReadS RemoveTags
Prelude.Read, Int -> RemoveTags -> ShowS
[RemoveTags] -> ShowS
RemoveTags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoveTags] -> ShowS
$cshowList :: [RemoveTags] -> ShowS
show :: RemoveTags -> String
$cshow :: RemoveTags -> String
showsPrec :: Int -> RemoveTags -> ShowS
$cshowsPrec :: Int -> RemoveTags -> ShowS
Prelude.Show, forall x. Rep RemoveTags x -> RemoveTags
forall x. RemoveTags -> Rep RemoveTags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoveTags x -> RemoveTags
$cfrom :: forall x. RemoveTags -> Rep RemoveTags x
Prelude.Generic)

-- |
-- Create a value of 'RemoveTags' 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', 'removeTags_arn' - Specifies the @ARN@ for the Elasticsearch domain from which you want to
-- delete the specified tags.
--
-- 'tagKeys', 'removeTags_tagKeys' - Specifies the @TagKey@ list which you want to remove from the
-- Elasticsearch domain.
newRemoveTags ::
  -- | 'arn'
  Prelude.Text ->
  RemoveTags
newRemoveTags :: Text -> RemoveTags
newRemoveTags Text
pARN_ =
  RemoveTags' {$sel:arn:RemoveTags' :: Text
arn = Text
pARN_, $sel:tagKeys:RemoveTags' :: [Text]
tagKeys = forall a. Monoid a => a
Prelude.mempty}

-- | Specifies the @ARN@ for the Elasticsearch domain from which you want to
-- delete the specified tags.
removeTags_arn :: Lens.Lens' RemoveTags Prelude.Text
removeTags_arn :: Lens' RemoveTags Text
removeTags_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveTags' {Text
arn :: Text
$sel:arn:RemoveTags' :: RemoveTags -> Text
arn} -> Text
arn) (\s :: RemoveTags
s@RemoveTags' {} Text
a -> RemoveTags
s {$sel:arn:RemoveTags' :: Text
arn = Text
a} :: RemoveTags)

-- | Specifies the @TagKey@ list which you want to remove from the
-- Elasticsearch domain.
removeTags_tagKeys :: Lens.Lens' RemoveTags [Prelude.Text]
removeTags_tagKeys :: Lens' RemoveTags [Text]
removeTags_tagKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveTags' {[Text]
tagKeys :: [Text]
$sel:tagKeys:RemoveTags' :: RemoveTags -> [Text]
tagKeys} -> [Text]
tagKeys) (\s :: RemoveTags
s@RemoveTags' {} [Text]
a -> RemoveTags
s {$sel:tagKeys:RemoveTags' :: [Text]
tagKeys = [Text]
a} :: RemoveTags) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

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

instance Prelude.NFData RemoveTags where
  rnf :: RemoveTags -> ()
rnf RemoveTags' {[Text]
Text
tagKeys :: [Text]
arn :: Text
$sel:tagKeys:RemoveTags' :: RemoveTags -> [Text]
$sel:arn:RemoveTags' :: RemoveTags -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
arn seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
tagKeys

instance Data.ToHeaders RemoveTags where
  toHeaders :: RemoveTags -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON RemoveTags where
  toJSON :: RemoveTags -> Value
toJSON RemoveTags' {[Text]
Text
tagKeys :: [Text]
arn :: Text
$sel:tagKeys:RemoveTags' :: RemoveTags -> [Text]
$sel:arn:RemoveTags' :: RemoveTags -> 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),
            forall a. a -> Maybe a
Prelude.Just (Key
"TagKeys" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
tagKeys)
          ]
      )

instance Data.ToPath RemoveTags where
  toPath :: RemoveTags -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2015-01-01/tags-removal"

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

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

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

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