{-# 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.UpdateRole
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the description or maximum session duration setting of a role.
module Amazonka.IAM.UpdateRole
  ( -- * Creating a Request
    UpdateRole (..),
    newUpdateRole,

    -- * Request Lenses
    updateRole_description,
    updateRole_maxSessionDuration,
    updateRole_roleName,

    -- * Destructuring the Response
    UpdateRoleResponse (..),
    newUpdateRoleResponse,

    -- * Response Lenses
    updateRoleResponse_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:/ 'newUpdateRole' smart constructor.
data UpdateRole = UpdateRole'
  { -- | The new description that you want to apply to the specified role.
    UpdateRole -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The maximum session duration (in seconds) that you want to set for the
    -- specified role. If you do not specify a value for this setting, the
    -- default value of one hour is applied. This setting can have a value from
    -- 1 hour to 12 hours.
    --
    -- Anyone who assumes the role from the CLI or API can use the
    -- @DurationSeconds@ API parameter or the @duration-seconds@ CLI parameter
    -- to request a longer session. The @MaxSessionDuration@ setting determines
    -- the maximum duration that can be requested using the @DurationSeconds@
    -- parameter. If users don\'t specify a value for the @DurationSeconds@
    -- parameter, their security credentials are valid for one hour by default.
    -- This applies when you use the @AssumeRole*@ API operations or the
    -- @assume-role*@ CLI operations but does not apply when you use those
    -- operations to create a console URL. For more information, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles_use.html Using IAM roles>
    -- in the /IAM User Guide/.
    UpdateRole -> Maybe Natural
maxSessionDuration :: Prelude.Maybe Prelude.Natural,
    -- | The name of the role that you want to modify.
    UpdateRole -> Text
roleName :: Prelude.Text
  }
  deriving (UpdateRole -> UpdateRole -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRole -> UpdateRole -> Bool
$c/= :: UpdateRole -> UpdateRole -> Bool
== :: UpdateRole -> UpdateRole -> Bool
$c== :: UpdateRole -> UpdateRole -> Bool
Prelude.Eq, ReadPrec [UpdateRole]
ReadPrec UpdateRole
Int -> ReadS UpdateRole
ReadS [UpdateRole]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRole]
$creadListPrec :: ReadPrec [UpdateRole]
readPrec :: ReadPrec UpdateRole
$creadPrec :: ReadPrec UpdateRole
readList :: ReadS [UpdateRole]
$creadList :: ReadS [UpdateRole]
readsPrec :: Int -> ReadS UpdateRole
$creadsPrec :: Int -> ReadS UpdateRole
Prelude.Read, Int -> UpdateRole -> ShowS
[UpdateRole] -> ShowS
UpdateRole -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRole] -> ShowS
$cshowList :: [UpdateRole] -> ShowS
show :: UpdateRole -> String
$cshow :: UpdateRole -> String
showsPrec :: Int -> UpdateRole -> ShowS
$cshowsPrec :: Int -> UpdateRole -> ShowS
Prelude.Show, forall x. Rep UpdateRole x -> UpdateRole
forall x. UpdateRole -> Rep UpdateRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateRole x -> UpdateRole
$cfrom :: forall x. UpdateRole -> Rep UpdateRole x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRole' 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:
--
-- 'description', 'updateRole_description' - The new description that you want to apply to the specified role.
--
-- 'maxSessionDuration', 'updateRole_maxSessionDuration' - The maximum session duration (in seconds) that you want to set for the
-- specified role. If you do not specify a value for this setting, the
-- default value of one hour is applied. This setting can have a value from
-- 1 hour to 12 hours.
--
-- Anyone who assumes the role from the CLI or API can use the
-- @DurationSeconds@ API parameter or the @duration-seconds@ CLI parameter
-- to request a longer session. The @MaxSessionDuration@ setting determines
-- the maximum duration that can be requested using the @DurationSeconds@
-- parameter. If users don\'t specify a value for the @DurationSeconds@
-- parameter, their security credentials are valid for one hour by default.
-- This applies when you use the @AssumeRole*@ API operations or the
-- @assume-role*@ CLI operations but does not apply when you use those
-- operations to create a console URL. For more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles_use.html Using IAM roles>
-- in the /IAM User Guide/.
--
-- 'roleName', 'updateRole_roleName' - The name of the role that you want to modify.
newUpdateRole ::
  -- | 'roleName'
  Prelude.Text ->
  UpdateRole
newUpdateRole :: Text -> UpdateRole
newUpdateRole Text
pRoleName_ =
  UpdateRole'
    { $sel:description:UpdateRole' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:maxSessionDuration:UpdateRole' :: Maybe Natural
maxSessionDuration = forall a. Maybe a
Prelude.Nothing,
      $sel:roleName:UpdateRole' :: Text
roleName = Text
pRoleName_
    }

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

-- | The maximum session duration (in seconds) that you want to set for the
-- specified role. If you do not specify a value for this setting, the
-- default value of one hour is applied. This setting can have a value from
-- 1 hour to 12 hours.
--
-- Anyone who assumes the role from the CLI or API can use the
-- @DurationSeconds@ API parameter or the @duration-seconds@ CLI parameter
-- to request a longer session. The @MaxSessionDuration@ setting determines
-- the maximum duration that can be requested using the @DurationSeconds@
-- parameter. If users don\'t specify a value for the @DurationSeconds@
-- parameter, their security credentials are valid for one hour by default.
-- This applies when you use the @AssumeRole*@ API operations or the
-- @assume-role*@ CLI operations but does not apply when you use those
-- operations to create a console URL. For more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles_use.html Using IAM roles>
-- in the /IAM User Guide/.
updateRole_maxSessionDuration :: Lens.Lens' UpdateRole (Prelude.Maybe Prelude.Natural)
updateRole_maxSessionDuration :: Lens' UpdateRole (Maybe Natural)
updateRole_maxSessionDuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRole' {Maybe Natural
maxSessionDuration :: Maybe Natural
$sel:maxSessionDuration:UpdateRole' :: UpdateRole -> Maybe Natural
maxSessionDuration} -> Maybe Natural
maxSessionDuration) (\s :: UpdateRole
s@UpdateRole' {} Maybe Natural
a -> UpdateRole
s {$sel:maxSessionDuration:UpdateRole' :: Maybe Natural
maxSessionDuration = Maybe Natural
a} :: UpdateRole)

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

instance Core.AWSRequest UpdateRole where
  type AWSResponse UpdateRole = UpdateRoleResponse
  request :: (Service -> Service) -> UpdateRole -> Request UpdateRole
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 UpdateRole
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateRole)))
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
"UpdateRoleResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> UpdateRoleResponse
UpdateRoleResponse'
            forall (f :: * -> *) a b. Functor 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 UpdateRole where
  hashWithSalt :: Int -> UpdateRole -> Int
hashWithSalt Int
_salt UpdateRole' {Maybe Natural
Maybe Text
Text
roleName :: Text
maxSessionDuration :: Maybe Natural
description :: Maybe Text
$sel:roleName:UpdateRole' :: UpdateRole -> Text
$sel:maxSessionDuration:UpdateRole' :: UpdateRole -> Maybe Natural
$sel:description:UpdateRole' :: UpdateRole -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxSessionDuration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleName

instance Prelude.NFData UpdateRole where
  rnf :: UpdateRole -> ()
rnf UpdateRole' {Maybe Natural
Maybe Text
Text
roleName :: Text
maxSessionDuration :: Maybe Natural
description :: Maybe Text
$sel:roleName:UpdateRole' :: UpdateRole -> Text
$sel:maxSessionDuration:UpdateRole' :: UpdateRole -> Maybe Natural
$sel:description:UpdateRole' :: UpdateRole -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxSessionDuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleName

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

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

instance Data.ToQuery UpdateRole where
  toQuery :: UpdateRole -> QueryString
toQuery UpdateRole' {Maybe Natural
Maybe Text
Text
roleName :: Text
maxSessionDuration :: Maybe Natural
description :: Maybe Text
$sel:roleName:UpdateRole' :: UpdateRole -> Text
$sel:maxSessionDuration:UpdateRole' :: UpdateRole -> Maybe Natural
$sel:description:UpdateRole' :: UpdateRole -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"UpdateRole" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"MaxSessionDuration" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxSessionDuration,
        ByteString
"RoleName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
roleName
      ]

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

-- |
-- Create a value of 'UpdateRoleResponse' 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:
--
-- 'httpStatus', 'updateRoleResponse_httpStatus' - The response's http status code.
newUpdateRoleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateRoleResponse
newUpdateRoleResponse :: Int -> UpdateRoleResponse
newUpdateRoleResponse Int
pHttpStatus_ =
  UpdateRoleResponse' {$sel:httpStatus:UpdateRoleResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData UpdateRoleResponse where
  rnf :: UpdateRoleResponse -> ()
rnf UpdateRoleResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateRoleResponse' :: UpdateRoleResponse -> Int
..} = forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus