{-# 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.Redshift.CreateTags
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds tags to a cluster.
--
-- A resource can have up to 50 tags. If you try to create more than 50
-- tags for a resource, you will receive an error and the attempt will
-- fail.
--
-- If you specify a key that already exists for the resource, the value for
-- that key will be updated with the new value.
module Amazonka.Redshift.CreateTags
  ( -- * Creating a Request
    CreateTags (..),
    newCreateTags,

    -- * Request Lenses
    createTags_resourceName,
    createTags_tags,

    -- * Destructuring the Response
    CreateTagsResponse (..),
    newCreateTagsResponse,
  )
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 Amazonka.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Contains the output from the @CreateTags@ action.
--
-- /See:/ 'newCreateTags' smart constructor.
data CreateTags = CreateTags'
  { -- | The Amazon Resource Name (ARN) to which you want to add the tag or tags.
    -- For example, @arn:aws:redshift:us-east-2:123456789:cluster:t1@.
    CreateTags -> Text
resourceName :: Prelude.Text,
    -- | One or more name\/value pairs to add as tags to the specified resource.
    -- Each tag name is passed in with the parameter @Key@ and the
    -- corresponding value is passed in with the parameter @Value@. The @Key@
    -- and @Value@ parameters are separated by a comma (,). Separate multiple
    -- tags with a space. For example,
    -- @--tags \"Key\"=\"owner\",\"Value\"=\"admin\" \"Key\"=\"environment\",\"Value\"=\"test\" \"Key\"=\"version\",\"Value\"=\"1.0\"@.
    CreateTags -> [Tag]
tags :: [Tag]
  }
  deriving (CreateTags -> CreateTags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTags -> CreateTags -> Bool
$c/= :: CreateTags -> CreateTags -> Bool
== :: CreateTags -> CreateTags -> Bool
$c== :: CreateTags -> CreateTags -> Bool
Prelude.Eq, ReadPrec [CreateTags]
ReadPrec CreateTags
Int -> ReadS CreateTags
ReadS [CreateTags]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTags]
$creadListPrec :: ReadPrec [CreateTags]
readPrec :: ReadPrec CreateTags
$creadPrec :: ReadPrec CreateTags
readList :: ReadS [CreateTags]
$creadList :: ReadS [CreateTags]
readsPrec :: Int -> ReadS CreateTags
$creadsPrec :: Int -> ReadS CreateTags
Prelude.Read, Int -> CreateTags -> ShowS
[CreateTags] -> ShowS
CreateTags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTags] -> ShowS
$cshowList :: [CreateTags] -> ShowS
show :: CreateTags -> String
$cshow :: CreateTags -> String
showsPrec :: Int -> CreateTags -> ShowS
$cshowsPrec :: Int -> CreateTags -> ShowS
Prelude.Show, forall x. Rep CreateTags x -> CreateTags
forall x. CreateTags -> Rep CreateTags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTags x -> CreateTags
$cfrom :: forall x. CreateTags -> Rep CreateTags x
Prelude.Generic)

-- |
-- Create a value of 'CreateTags' 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:
--
-- 'resourceName', 'createTags_resourceName' - The Amazon Resource Name (ARN) to which you want to add the tag or tags.
-- For example, @arn:aws:redshift:us-east-2:123456789:cluster:t1@.
--
-- 'tags', 'createTags_tags' - One or more name\/value pairs to add as tags to the specified resource.
-- Each tag name is passed in with the parameter @Key@ and the
-- corresponding value is passed in with the parameter @Value@. The @Key@
-- and @Value@ parameters are separated by a comma (,). Separate multiple
-- tags with a space. For example,
-- @--tags \"Key\"=\"owner\",\"Value\"=\"admin\" \"Key\"=\"environment\",\"Value\"=\"test\" \"Key\"=\"version\",\"Value\"=\"1.0\"@.
newCreateTags ::
  -- | 'resourceName'
  Prelude.Text ->
  CreateTags
newCreateTags :: Text -> CreateTags
newCreateTags Text
pResourceName_ =
  CreateTags'
    { $sel:resourceName:CreateTags' :: Text
resourceName = Text
pResourceName_,
      $sel:tags:CreateTags' :: [Tag]
tags = forall a. Monoid a => a
Prelude.mempty
    }

-- | The Amazon Resource Name (ARN) to which you want to add the tag or tags.
-- For example, @arn:aws:redshift:us-east-2:123456789:cluster:t1@.
createTags_resourceName :: Lens.Lens' CreateTags Prelude.Text
createTags_resourceName :: Lens' CreateTags Text
createTags_resourceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTags' {Text
resourceName :: Text
$sel:resourceName:CreateTags' :: CreateTags -> Text
resourceName} -> Text
resourceName) (\s :: CreateTags
s@CreateTags' {} Text
a -> CreateTags
s {$sel:resourceName:CreateTags' :: Text
resourceName = Text
a} :: CreateTags)

-- | One or more name\/value pairs to add as tags to the specified resource.
-- Each tag name is passed in with the parameter @Key@ and the
-- corresponding value is passed in with the parameter @Value@. The @Key@
-- and @Value@ parameters are separated by a comma (,). Separate multiple
-- tags with a space. For example,
-- @--tags \"Key\"=\"owner\",\"Value\"=\"admin\" \"Key\"=\"environment\",\"Value\"=\"test\" \"Key\"=\"version\",\"Value\"=\"1.0\"@.
createTags_tags :: Lens.Lens' CreateTags [Tag]
createTags_tags :: Lens' CreateTags [Tag]
createTags_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTags' {[Tag]
tags :: [Tag]
$sel:tags:CreateTags' :: CreateTags -> [Tag]
tags} -> [Tag]
tags) (\s :: CreateTags
s@CreateTags' {} [Tag]
a -> CreateTags
s {$sel:tags:CreateTags' :: [Tag]
tags = [Tag]
a} :: CreateTags) 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 CreateTags where
  type AWSResponse CreateTags = CreateTagsResponse
  request :: (Service -> Service) -> CreateTags -> Request CreateTags
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 CreateTags
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateTags)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull CreateTagsResponse
CreateTagsResponse'

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

instance Prelude.NFData CreateTags where
  rnf :: CreateTags -> ()
rnf CreateTags' {[Tag]
Text
tags :: [Tag]
resourceName :: Text
$sel:tags:CreateTags' :: CreateTags -> [Tag]
$sel:resourceName:CreateTags' :: CreateTags -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
resourceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Tag]
tags

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

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

instance Data.ToQuery CreateTags where
  toQuery :: CreateTags -> QueryString
toQuery CreateTags' {[Tag]
Text
tags :: [Tag]
resourceName :: Text
$sel:tags:CreateTags' :: CreateTags -> [Tag]
$sel:resourceName:CreateTags' :: CreateTags -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateTags" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"ResourceName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
resourceName,
        ByteString
"Tags" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Tag" [Tag]
tags
      ]

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

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

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