{-# 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.UpdateRoleDescription
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use UpdateRole instead.
--
-- Modifies only the description of a role. This operation performs the
-- same function as the @Description@ parameter in the @UpdateRole@
-- operation.
module Amazonka.IAM.UpdateRoleDescription
  ( -- * Creating a Request
    UpdateRoleDescription (..),
    newUpdateRoleDescription,

    -- * Request Lenses
    updateRoleDescription_roleName,
    updateRoleDescription_description,

    -- * Destructuring the Response
    UpdateRoleDescriptionResponse (..),
    newUpdateRoleDescriptionResponse,

    -- * Response Lenses
    updateRoleDescriptionResponse_role,
    updateRoleDescriptionResponse_httpStatus,
  )
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:/ 'newUpdateRoleDescription' smart constructor.
data UpdateRoleDescription = UpdateRoleDescription'
  { -- | The name of the role that you want to modify.
    UpdateRoleDescription -> Text
roleName :: Prelude.Text,
    -- | The new description that you want to apply to the specified role.
    UpdateRoleDescription -> Text
description :: Prelude.Text
  }
  deriving (UpdateRoleDescription -> UpdateRoleDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRoleDescription -> UpdateRoleDescription -> Bool
$c/= :: UpdateRoleDescription -> UpdateRoleDescription -> Bool
== :: UpdateRoleDescription -> UpdateRoleDescription -> Bool
$c== :: UpdateRoleDescription -> UpdateRoleDescription -> Bool
Prelude.Eq, ReadPrec [UpdateRoleDescription]
ReadPrec UpdateRoleDescription
Int -> ReadS UpdateRoleDescription
ReadS [UpdateRoleDescription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRoleDescription]
$creadListPrec :: ReadPrec [UpdateRoleDescription]
readPrec :: ReadPrec UpdateRoleDescription
$creadPrec :: ReadPrec UpdateRoleDescription
readList :: ReadS [UpdateRoleDescription]
$creadList :: ReadS [UpdateRoleDescription]
readsPrec :: Int -> ReadS UpdateRoleDescription
$creadsPrec :: Int -> ReadS UpdateRoleDescription
Prelude.Read, Int -> UpdateRoleDescription -> ShowS
[UpdateRoleDescription] -> ShowS
UpdateRoleDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRoleDescription] -> ShowS
$cshowList :: [UpdateRoleDescription] -> ShowS
show :: UpdateRoleDescription -> String
$cshow :: UpdateRoleDescription -> String
showsPrec :: Int -> UpdateRoleDescription -> ShowS
$cshowsPrec :: Int -> UpdateRoleDescription -> ShowS
Prelude.Show, forall x. Rep UpdateRoleDescription x -> UpdateRoleDescription
forall x. UpdateRoleDescription -> Rep UpdateRoleDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateRoleDescription x -> UpdateRoleDescription
$cfrom :: forall x. UpdateRoleDescription -> Rep UpdateRoleDescription x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRoleDescription' 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', 'updateRoleDescription_roleName' - The name of the role that you want to modify.
--
-- 'description', 'updateRoleDescription_description' - The new description that you want to apply to the specified role.
newUpdateRoleDescription ::
  -- | 'roleName'
  Prelude.Text ->
  -- | 'description'
  Prelude.Text ->
  UpdateRoleDescription
newUpdateRoleDescription :: Text -> Text -> UpdateRoleDescription
newUpdateRoleDescription Text
pRoleName_ Text
pDescription_ =
  UpdateRoleDescription'
    { $sel:roleName:UpdateRoleDescription' :: Text
roleName = Text
pRoleName_,
      $sel:description:UpdateRoleDescription' :: Text
description = Text
pDescription_
    }

-- | The name of the role that you want to modify.
updateRoleDescription_roleName :: Lens.Lens' UpdateRoleDescription Prelude.Text
updateRoleDescription_roleName :: Lens' UpdateRoleDescription Text
updateRoleDescription_roleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoleDescription' {Text
roleName :: Text
$sel:roleName:UpdateRoleDescription' :: UpdateRoleDescription -> Text
roleName} -> Text
roleName) (\s :: UpdateRoleDescription
s@UpdateRoleDescription' {} Text
a -> UpdateRoleDescription
s {$sel:roleName:UpdateRoleDescription' :: Text
roleName = Text
a} :: UpdateRoleDescription)

-- | The new description that you want to apply to the specified role.
updateRoleDescription_description :: Lens.Lens' UpdateRoleDescription Prelude.Text
updateRoleDescription_description :: Lens' UpdateRoleDescription Text
updateRoleDescription_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoleDescription' {Text
description :: Text
$sel:description:UpdateRoleDescription' :: UpdateRoleDescription -> Text
description} -> Text
description) (\s :: UpdateRoleDescription
s@UpdateRoleDescription' {} Text
a -> UpdateRoleDescription
s {$sel:description:UpdateRoleDescription' :: Text
description = Text
a} :: UpdateRoleDescription)

instance Core.AWSRequest UpdateRoleDescription where
  type
    AWSResponse UpdateRoleDescription =
      UpdateRoleDescriptionResponse
  request :: (Service -> Service)
-> UpdateRoleDescription -> Request UpdateRoleDescription
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 UpdateRoleDescription
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateRoleDescription)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"UpdateRoleDescriptionResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Role -> Int -> UpdateRoleDescriptionResponse
UpdateRoleDescriptionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Role")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateRoleDescription where
  hashWithSalt :: Int -> UpdateRoleDescription -> Int
hashWithSalt Int
_salt UpdateRoleDescription' {Text
description :: Text
roleName :: Text
$sel:description:UpdateRoleDescription' :: UpdateRoleDescription -> Text
$sel:roleName:UpdateRoleDescription' :: UpdateRoleDescription -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
description

instance Prelude.NFData UpdateRoleDescription where
  rnf :: UpdateRoleDescription -> ()
rnf UpdateRoleDescription' {Text
description :: Text
roleName :: Text
$sel:description:UpdateRoleDescription' :: UpdateRoleDescription -> Text
$sel:roleName:UpdateRoleDescription' :: UpdateRoleDescription -> 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
description

instance Data.ToHeaders UpdateRoleDescription where
  toHeaders :: UpdateRoleDescription -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery UpdateRoleDescription where
  toQuery :: UpdateRoleDescription -> QueryString
toQuery UpdateRoleDescription' {Text
description :: Text
roleName :: Text
$sel:description:UpdateRoleDescription' :: UpdateRoleDescription -> Text
$sel:roleName:UpdateRoleDescription' :: UpdateRoleDescription -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"UpdateRoleDescription" :: 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
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
description
      ]

-- | /See:/ 'newUpdateRoleDescriptionResponse' smart constructor.
data UpdateRoleDescriptionResponse = UpdateRoleDescriptionResponse'
  { -- | A structure that contains details about the modified role.
    UpdateRoleDescriptionResponse -> Maybe Role
role' :: Prelude.Maybe Role,
    -- | The response's http status code.
    UpdateRoleDescriptionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateRoleDescriptionResponse
-> UpdateRoleDescriptionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRoleDescriptionResponse
-> UpdateRoleDescriptionResponse -> Bool
$c/= :: UpdateRoleDescriptionResponse
-> UpdateRoleDescriptionResponse -> Bool
== :: UpdateRoleDescriptionResponse
-> UpdateRoleDescriptionResponse -> Bool
$c== :: UpdateRoleDescriptionResponse
-> UpdateRoleDescriptionResponse -> Bool
Prelude.Eq, ReadPrec [UpdateRoleDescriptionResponse]
ReadPrec UpdateRoleDescriptionResponse
Int -> ReadS UpdateRoleDescriptionResponse
ReadS [UpdateRoleDescriptionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRoleDescriptionResponse]
$creadListPrec :: ReadPrec [UpdateRoleDescriptionResponse]
readPrec :: ReadPrec UpdateRoleDescriptionResponse
$creadPrec :: ReadPrec UpdateRoleDescriptionResponse
readList :: ReadS [UpdateRoleDescriptionResponse]
$creadList :: ReadS [UpdateRoleDescriptionResponse]
readsPrec :: Int -> ReadS UpdateRoleDescriptionResponse
$creadsPrec :: Int -> ReadS UpdateRoleDescriptionResponse
Prelude.Read, Int -> UpdateRoleDescriptionResponse -> ShowS
[UpdateRoleDescriptionResponse] -> ShowS
UpdateRoleDescriptionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRoleDescriptionResponse] -> ShowS
$cshowList :: [UpdateRoleDescriptionResponse] -> ShowS
show :: UpdateRoleDescriptionResponse -> String
$cshow :: UpdateRoleDescriptionResponse -> String
showsPrec :: Int -> UpdateRoleDescriptionResponse -> ShowS
$cshowsPrec :: Int -> UpdateRoleDescriptionResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateRoleDescriptionResponse x
-> UpdateRoleDescriptionResponse
forall x.
UpdateRoleDescriptionResponse
-> Rep UpdateRoleDescriptionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateRoleDescriptionResponse x
-> UpdateRoleDescriptionResponse
$cfrom :: forall x.
UpdateRoleDescriptionResponse
-> Rep UpdateRoleDescriptionResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRoleDescriptionResponse' 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:
--
-- 'role'', 'updateRoleDescriptionResponse_role' - A structure that contains details about the modified role.
--
-- 'httpStatus', 'updateRoleDescriptionResponse_httpStatus' - The response's http status code.
newUpdateRoleDescriptionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateRoleDescriptionResponse
newUpdateRoleDescriptionResponse :: Int -> UpdateRoleDescriptionResponse
newUpdateRoleDescriptionResponse Int
pHttpStatus_ =
  UpdateRoleDescriptionResponse'
    { $sel:role':UpdateRoleDescriptionResponse' :: Maybe Role
role' =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateRoleDescriptionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A structure that contains details about the modified role.
updateRoleDescriptionResponse_role :: Lens.Lens' UpdateRoleDescriptionResponse (Prelude.Maybe Role)
updateRoleDescriptionResponse_role :: Lens' UpdateRoleDescriptionResponse (Maybe Role)
updateRoleDescriptionResponse_role = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoleDescriptionResponse' {Maybe Role
role' :: Maybe Role
$sel:role':UpdateRoleDescriptionResponse' :: UpdateRoleDescriptionResponse -> Maybe Role
role'} -> Maybe Role
role') (\s :: UpdateRoleDescriptionResponse
s@UpdateRoleDescriptionResponse' {} Maybe Role
a -> UpdateRoleDescriptionResponse
s {$sel:role':UpdateRoleDescriptionResponse' :: Maybe Role
role' = Maybe Role
a} :: UpdateRoleDescriptionResponse)

-- | The response's http status code.
updateRoleDescriptionResponse_httpStatus :: Lens.Lens' UpdateRoleDescriptionResponse Prelude.Int
updateRoleDescriptionResponse_httpStatus :: Lens' UpdateRoleDescriptionResponse Int
updateRoleDescriptionResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoleDescriptionResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateRoleDescriptionResponse' :: UpdateRoleDescriptionResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateRoleDescriptionResponse
s@UpdateRoleDescriptionResponse' {} Int
a -> UpdateRoleDescriptionResponse
s {$sel:httpStatus:UpdateRoleDescriptionResponse' :: Int
httpStatus = Int
a} :: UpdateRoleDescriptionResponse)

instance Prelude.NFData UpdateRoleDescriptionResponse where
  rnf :: UpdateRoleDescriptionResponse -> ()
rnf UpdateRoleDescriptionResponse' {Int
Maybe Role
httpStatus :: Int
role' :: Maybe Role
$sel:httpStatus:UpdateRoleDescriptionResponse' :: UpdateRoleDescriptionResponse -> Int
$sel:role':UpdateRoleDescriptionResponse' :: UpdateRoleDescriptionResponse -> Maybe Role
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Role
role'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus