{-# 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.UntagRole
-- 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 tags from the role. 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/.
module Amazonka.IAM.UntagRole
  ( -- * Creating a Request
    UntagRole (..),
    newUntagRole,

    -- * Request Lenses
    untagRole_roleName,
    untagRole_tagKeys,

    -- * Destructuring the Response
    UntagRoleResponse (..),
    newUntagRoleResponse,
  )
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:/ 'newUntagRole' smart constructor.
data UntagRole = UntagRole'
  { -- | The name of the IAM role from which you want to remove 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: _+=,.\@-
    UntagRole -> Text
roleName :: Prelude.Text,
    -- | A list of key names as a simple array of strings. The tags with matching
    -- keys are removed from the specified role.
    UntagRole -> [Text]
tagKeys :: [Prelude.Text]
  }
  deriving (UntagRole -> UntagRole -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UntagRole -> UntagRole -> Bool
$c/= :: UntagRole -> UntagRole -> Bool
== :: UntagRole -> UntagRole -> Bool
$c== :: UntagRole -> UntagRole -> Bool
Prelude.Eq, ReadPrec [UntagRole]
ReadPrec UntagRole
Int -> ReadS UntagRole
ReadS [UntagRole]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UntagRole]
$creadListPrec :: ReadPrec [UntagRole]
readPrec :: ReadPrec UntagRole
$creadPrec :: ReadPrec UntagRole
readList :: ReadS [UntagRole]
$creadList :: ReadS [UntagRole]
readsPrec :: Int -> ReadS UntagRole
$creadsPrec :: Int -> ReadS UntagRole
Prelude.Read, Int -> UntagRole -> ShowS
[UntagRole] -> ShowS
UntagRole -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UntagRole] -> ShowS
$cshowList :: [UntagRole] -> ShowS
show :: UntagRole -> String
$cshow :: UntagRole -> String
showsPrec :: Int -> UntagRole -> ShowS
$cshowsPrec :: Int -> UntagRole -> ShowS
Prelude.Show, forall x. Rep UntagRole x -> UntagRole
forall x. UntagRole -> Rep UntagRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UntagRole x -> UntagRole
$cfrom :: forall x. UntagRole -> Rep UntagRole x
Prelude.Generic)

-- |
-- Create a value of 'UntagRole' 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', 'untagRole_roleName' - The name of the IAM role from which you want to remove 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: _+=,.\@-
--
-- 'tagKeys', 'untagRole_tagKeys' - A list of key names as a simple array of strings. The tags with matching
-- keys are removed from the specified role.
newUntagRole ::
  -- | 'roleName'
  Prelude.Text ->
  UntagRole
newUntagRole :: Text -> UntagRole
newUntagRole Text
pRoleName_ =
  UntagRole'
    { $sel:roleName:UntagRole' :: Text
roleName = Text
pRoleName_,
      $sel:tagKeys:UntagRole' :: [Text]
tagKeys = forall a. Monoid a => a
Prelude.mempty
    }

-- | The name of the IAM role from which you want to remove 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: _+=,.\@-
untagRole_roleName :: Lens.Lens' UntagRole Prelude.Text
untagRole_roleName :: Lens' UntagRole Text
untagRole_roleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UntagRole' {Text
roleName :: Text
$sel:roleName:UntagRole' :: UntagRole -> Text
roleName} -> Text
roleName) (\s :: UntagRole
s@UntagRole' {} Text
a -> UntagRole
s {$sel:roleName:UntagRole' :: Text
roleName = Text
a} :: UntagRole)

-- | A list of key names as a simple array of strings. The tags with matching
-- keys are removed from the specified role.
untagRole_tagKeys :: Lens.Lens' UntagRole [Prelude.Text]
untagRole_tagKeys :: Lens' UntagRole [Text]
untagRole_tagKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UntagRole' {[Text]
tagKeys :: [Text]
$sel:tagKeys:UntagRole' :: UntagRole -> [Text]
tagKeys} -> [Text]
tagKeys) (\s :: UntagRole
s@UntagRole' {} [Text]
a -> UntagRole
s {$sel:tagKeys:UntagRole' :: [Text]
tagKeys = [Text]
a} :: UntagRole) 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 UntagRole where
  type AWSResponse UntagRole = UntagRoleResponse
  request :: (Service -> Service) -> UntagRole -> Request UntagRole
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 UntagRole
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UntagRole)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UntagRoleResponse
UntagRoleResponse'

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

instance Prelude.NFData UntagRole where
  rnf :: UntagRole -> ()
rnf UntagRole' {[Text]
Text
tagKeys :: [Text]
roleName :: Text
$sel:tagKeys:UntagRole' :: UntagRole -> [Text]
$sel:roleName:UntagRole' :: UntagRole -> 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 [Text]
tagKeys

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

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

instance Data.ToQuery UntagRole where
  toQuery :: UntagRole -> QueryString
toQuery UntagRole' {[Text]
Text
tagKeys :: [Text]
roleName :: Text
$sel:tagKeys:UntagRole' :: UntagRole -> [Text]
$sel:roleName:UntagRole' :: UntagRole -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"UntagRole" :: 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
"TagKeys" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [Text]
tagKeys
      ]

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

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

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