{-# 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.TagInstanceProfile
-- 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 instance profile. If a tag with the same
-- key name already exists, then that tag is overwritten with the new
-- value.
--
-- Each 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 instance profile that has a specified 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/.
--
-- -   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.
module Amazonka.IAM.TagInstanceProfile
  ( -- * Creating a Request
    TagInstanceProfile (..),
    newTagInstanceProfile,

    -- * Request Lenses
    tagInstanceProfile_instanceProfileName,
    tagInstanceProfile_tags,

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

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

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

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

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

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

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

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

instance Data.ToQuery TagInstanceProfile where
  toQuery :: TagInstanceProfile -> QueryString
toQuery TagInstanceProfile' {[Tag]
Text
tags :: [Tag]
instanceProfileName :: Text
$sel:tags:TagInstanceProfile' :: TagInstanceProfile -> [Tag]
$sel:instanceProfileName:TagInstanceProfile' :: TagInstanceProfile -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"TagInstanceProfile" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"InstanceProfileName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
instanceProfileName,
        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:/ 'newTagInstanceProfileResponse' smart constructor.
data TagInstanceProfileResponse = TagInstanceProfileResponse'
  {
  }
  deriving (TagInstanceProfileResponse -> TagInstanceProfileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagInstanceProfileResponse -> TagInstanceProfileResponse -> Bool
$c/= :: TagInstanceProfileResponse -> TagInstanceProfileResponse -> Bool
== :: TagInstanceProfileResponse -> TagInstanceProfileResponse -> Bool
$c== :: TagInstanceProfileResponse -> TagInstanceProfileResponse -> Bool
Prelude.Eq, ReadPrec [TagInstanceProfileResponse]
ReadPrec TagInstanceProfileResponse
Int -> ReadS TagInstanceProfileResponse
ReadS [TagInstanceProfileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagInstanceProfileResponse]
$creadListPrec :: ReadPrec [TagInstanceProfileResponse]
readPrec :: ReadPrec TagInstanceProfileResponse
$creadPrec :: ReadPrec TagInstanceProfileResponse
readList :: ReadS [TagInstanceProfileResponse]
$creadList :: ReadS [TagInstanceProfileResponse]
readsPrec :: Int -> ReadS TagInstanceProfileResponse
$creadsPrec :: Int -> ReadS TagInstanceProfileResponse
Prelude.Read, Int -> TagInstanceProfileResponse -> ShowS
[TagInstanceProfileResponse] -> ShowS
TagInstanceProfileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagInstanceProfileResponse] -> ShowS
$cshowList :: [TagInstanceProfileResponse] -> ShowS
show :: TagInstanceProfileResponse -> String
$cshow :: TagInstanceProfileResponse -> String
showsPrec :: Int -> TagInstanceProfileResponse -> ShowS
$cshowsPrec :: Int -> TagInstanceProfileResponse -> ShowS
Prelude.Show, forall x.
Rep TagInstanceProfileResponse x -> TagInstanceProfileResponse
forall x.
TagInstanceProfileResponse -> Rep TagInstanceProfileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TagInstanceProfileResponse x -> TagInstanceProfileResponse
$cfrom :: forall x.
TagInstanceProfileResponse -> Rep TagInstanceProfileResponse x
Prelude.Generic)

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

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