{-# 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.AddTags
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Attaches tags to an existing Elasticsearch domain. Tags are a set of
-- case-sensitive key value pairs. An Elasticsearch domain may have up to
-- 10 tags. See
-- <http://docs.aws.amazon.com/elasticsearch-service/latest/developerguide/es-managedomains.html#es-managedomains-awsresorcetagging Tagging Amazon Elasticsearch Service Domains for more information.>
module Amazonka.ElasticSearch.AddTags
  ( -- * Creating a Request
    AddTags (..),
    newAddTags,

    -- * Request Lenses
    addTags_arn,
    addTags_tagList,

    -- * Destructuring the Response
    AddTagsResponse (..),
    newAddTagsResponse,
  )
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 @AddTags@ operation. Specify the
-- tags that you want to attach to the Elasticsearch domain.
--
-- /See:/ 'newAddTags' smart constructor.
data AddTags = AddTags'
  { -- | Specify the @ARN@ for which you want to add the tags.
    AddTags -> Text
arn :: Prelude.Text,
    -- | List of @Tag@ that need to be added for the Elasticsearch domain.
    AddTags -> [Tag]
tagList :: [Tag]
  }
  deriving (AddTags -> AddTags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddTags -> AddTags -> Bool
$c/= :: AddTags -> AddTags -> Bool
== :: AddTags -> AddTags -> Bool
$c== :: AddTags -> AddTags -> Bool
Prelude.Eq, ReadPrec [AddTags]
ReadPrec AddTags
Int -> ReadS AddTags
ReadS [AddTags]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddTags]
$creadListPrec :: ReadPrec [AddTags]
readPrec :: ReadPrec AddTags
$creadPrec :: ReadPrec AddTags
readList :: ReadS [AddTags]
$creadList :: ReadS [AddTags]
readsPrec :: Int -> ReadS AddTags
$creadsPrec :: Int -> ReadS AddTags
Prelude.Read, Int -> AddTags -> ShowS
[AddTags] -> ShowS
AddTags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddTags] -> ShowS
$cshowList :: [AddTags] -> ShowS
show :: AddTags -> String
$cshow :: AddTags -> String
showsPrec :: Int -> AddTags -> ShowS
$cshowsPrec :: Int -> AddTags -> ShowS
Prelude.Show, forall x. Rep AddTags x -> AddTags
forall x. AddTags -> Rep AddTags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddTags x -> AddTags
$cfrom :: forall x. AddTags -> Rep AddTags x
Prelude.Generic)

-- |
-- Create a value of 'AddTags' 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', 'addTags_arn' - Specify the @ARN@ for which you want to add the tags.
--
-- 'tagList', 'addTags_tagList' - List of @Tag@ that need to be added for the Elasticsearch domain.
newAddTags ::
  -- | 'arn'
  Prelude.Text ->
  AddTags
newAddTags :: Text -> AddTags
newAddTags Text
pARN_ =
  AddTags' {$sel:arn:AddTags' :: Text
arn = Text
pARN_, $sel:tagList:AddTags' :: [Tag]
tagList = forall a. Monoid a => a
Prelude.mempty}

-- | Specify the @ARN@ for which you want to add the tags.
addTags_arn :: Lens.Lens' AddTags Prelude.Text
addTags_arn :: Lens' AddTags Text
addTags_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddTags' {Text
arn :: Text
$sel:arn:AddTags' :: AddTags -> Text
arn} -> Text
arn) (\s :: AddTags
s@AddTags' {} Text
a -> AddTags
s {$sel:arn:AddTags' :: Text
arn = Text
a} :: AddTags)

-- | List of @Tag@ that need to be added for the Elasticsearch domain.
addTags_tagList :: Lens.Lens' AddTags [Tag]
addTags_tagList :: Lens' AddTags [Tag]
addTags_tagList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddTags' {[Tag]
tagList :: [Tag]
$sel:tagList:AddTags' :: AddTags -> [Tag]
tagList} -> [Tag]
tagList) (\s :: AddTags
s@AddTags' {} [Tag]
a -> AddTags
s {$sel:tagList:AddTags' :: [Tag]
tagList = [Tag]
a} :: AddTags) 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 AddTags where
  type AWSResponse AddTags = AddTagsResponse
  request :: (Service -> Service) -> AddTags -> Request AddTags
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 AddTags
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AddTags)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull AddTagsResponse
AddTagsResponse'

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

instance Prelude.NFData AddTags where
  rnf :: AddTags -> ()
rnf AddTags' {[Tag]
Text
tagList :: [Tag]
arn :: Text
$sel:tagList:AddTags' :: AddTags -> [Tag]
$sel:arn:AddTags' :: AddTags -> 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 [Tag]
tagList

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

instance Data.ToJSON AddTags where
  toJSON :: AddTags -> Value
toJSON AddTags' {[Tag]
Text
tagList :: [Tag]
arn :: Text
$sel:tagList:AddTags' :: AddTags -> [Tag]
$sel:arn:AddTags' :: AddTags -> 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
"TagList" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Tag]
tagList)
          ]
      )

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

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

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

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

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