{-# 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.IAM.TagRole
-- 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 one or more tags to an IAM role. The role can be a regular role or
-- a service-linked role. If a tag with the same key name already exists,
-- then that tag is overwritten with the new value.
--
-- A tag consists of a key name and an associated value. By assigning tags
-- to your resources, you can do the following:
--
-- -   __Administrative grouping and discovery__ - Attach tags to resources
--     to aid in organization and search. For example, you could search for
--     all resources with the key name /Project/ and the value
--     /MyImportantProject/. Or search for all resources with the key name
--     /Cost Center/ and the value /41200/.
--
-- -   __Access control__ - Include tags in IAM user-based and
--     resource-based policies. You can use tags to restrict access to only
--     an IAM role that has a specified tag attached. You can also restrict
--     access to only those resources that have a certain tag attached. For
--     examples of policies that show how to use tags to control access,
--     see
--     <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_tags.html Control access using IAM tags>
--     in the /IAM User Guide/.
--
-- -   __Cost allocation__ - Use tags to help track which individuals and
--     teams are using which Amazon Web Services resources.
--
-- -   If any one of the tags is invalid or if you exceed the allowed
--     maximum number of tags, then the entire request fails and the
--     resource is not created. For more information about tagging, see
--     <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
--     in the /IAM User Guide/.
--
-- -   Amazon Web Services always interprets the tag @Value@ as a single
--     string. If you need to store an array, you can store comma-separated
--     values in the string. However, you must interpret the value in your
--     code.
--
-- For more information about tagging, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM identities>
-- in the /IAM User Guide/.
module Amazonka.IAM.TagRole
  ( -- * Creating a Request
    TagRole (..),
    newTagRole,

    -- * Request Lenses
    tagRole_roleName,
    tagRole_tags,

    -- * Destructuring the Response
    TagRoleResponse (..),
    newTagRoleResponse,
  )
where

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

-- | /See:/ 'newTagRole' smart constructor.
data TagRole = TagRole'
  { -- | The name of the IAM role to which you want to add tags.
    --
    -- This parameter accepts (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- that consist of upper and lowercase alphanumeric characters with no
    -- spaces. You can also include any of the following characters: _+=,.\@-
    TagRole -> Text
roleName :: Prelude.Text,
    -- | The list of tags that you want to attach to the IAM role. Each tag
    -- consists of a key name and an associated value.
    TagRole -> [Tag]
tags :: [Tag]
  }
  deriving (TagRole -> TagRole -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagRole -> TagRole -> Bool
$c/= :: TagRole -> TagRole -> Bool
== :: TagRole -> TagRole -> Bool
$c== :: TagRole -> TagRole -> Bool
Prelude.Eq, ReadPrec [TagRole]
ReadPrec TagRole
Int -> ReadS TagRole
ReadS [TagRole]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagRole]
$creadListPrec :: ReadPrec [TagRole]
readPrec :: ReadPrec TagRole
$creadPrec :: ReadPrec TagRole
readList :: ReadS [TagRole]
$creadList :: ReadS [TagRole]
readsPrec :: Int -> ReadS TagRole
$creadsPrec :: Int -> ReadS TagRole
Prelude.Read, Int -> TagRole -> ShowS
[TagRole] -> ShowS
TagRole -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagRole] -> ShowS
$cshowList :: [TagRole] -> ShowS
show :: TagRole -> String
$cshow :: TagRole -> String
showsPrec :: Int -> TagRole -> ShowS
$cshowsPrec :: Int -> TagRole -> ShowS
Prelude.Show, forall x. Rep TagRole x -> TagRole
forall x. TagRole -> Rep TagRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagRole x -> TagRole
$cfrom :: forall x. TagRole -> Rep TagRole x
Prelude.Generic)

-- |
-- Create a value of 'TagRole' 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:
--
-- 'roleName', 'tagRole_roleName' - The name of the IAM role to which you want to add tags.
--
-- This parameter accepts (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- that consist of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
--
-- 'tags', 'tagRole_tags' - The list of tags that you want to attach to the IAM role. Each tag
-- consists of a key name and an associated value.
newTagRole ::
  -- | 'roleName'
  Prelude.Text ->
  TagRole
newTagRole :: Text -> TagRole
newTagRole Text
pRoleName_ =
  TagRole'
    { $sel:roleName:TagRole' :: Text
roleName = Text
pRoleName_,
      $sel:tags:TagRole' :: [Tag]
tags = forall a. Monoid a => a
Prelude.mempty
    }

-- | The name of the IAM role to which you want to add tags.
--
-- This parameter accepts (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- that consist of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
tagRole_roleName :: Lens.Lens' TagRole Prelude.Text
tagRole_roleName :: Lens' TagRole Text
tagRole_roleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagRole' {Text
roleName :: Text
$sel:roleName:TagRole' :: TagRole -> Text
roleName} -> Text
roleName) (\s :: TagRole
s@TagRole' {} Text
a -> TagRole
s {$sel:roleName:TagRole' :: Text
roleName = Text
a} :: TagRole)

-- | The list of tags that you want to attach to the IAM role. Each tag
-- consists of a key name and an associated value.
tagRole_tags :: Lens.Lens' TagRole [Tag]
tagRole_tags :: Lens' TagRole [Tag]
tagRole_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagRole' {[Tag]
tags :: [Tag]
$sel:tags:TagRole' :: TagRole -> [Tag]
tags} -> [Tag]
tags) (\s :: TagRole
s@TagRole' {} [Tag]
a -> TagRole
s {$sel:tags:TagRole' :: [Tag]
tags = [Tag]
a} :: TagRole) 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 TagRole where
  type AWSResponse TagRole = TagRoleResponse
  request :: (Service -> Service) -> TagRole -> Request TagRole
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 TagRole
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse TagRole)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull TagRoleResponse
TagRoleResponse'

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

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

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

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

instance Data.ToQuery TagRole where
  toQuery :: TagRole -> QueryString
toQuery TagRole' {[Tag]
Text
tags :: [Tag]
roleName :: Text
$sel:tags:TagRole' :: TagRole -> [Tag]
$sel:roleName:TagRole' :: TagRole -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"TagRole" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"RoleName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
roleName,
        ByteString
"Tags" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [Tag]
tags
      ]

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

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

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