{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.Role
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.IAM.Types.Role 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.AttachedPermissionsBoundary
import Amazonka.IAM.Types.RoleLastUsed
import Amazonka.IAM.Types.Tag
import qualified Amazonka.Prelude as Prelude

-- | Contains information about an IAM role. This structure is returned as a
-- response element in several API operations that interact with roles.
--
-- /See:/ 'newRole' smart constructor.
data Role = Role'
  { -- | The policy that grants an entity permission to assume the role.
    Role -> Maybe Text
assumeRolePolicyDocument :: Prelude.Maybe Prelude.Text,
    -- | A description of the role that you provide.
    Role -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The maximum session duration (in seconds) for the specified role. Anyone
    -- who uses the CLI, or API to assume the role can specify the duration
    -- using the optional @DurationSeconds@ API parameter or @duration-seconds@
    -- CLI parameter.
    Role -> Maybe Natural
maxSessionDuration :: Prelude.Maybe Prelude.Natural,
    -- | The ARN of the policy used to set the permissions boundary for the role.
    --
    -- For more information about permissions boundaries, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_boundaries.html Permissions boundaries for IAM identities>
    -- in the /IAM User Guide/.
    Role -> Maybe AttachedPermissionsBoundary
permissionsBoundary :: Prelude.Maybe AttachedPermissionsBoundary,
    -- | Contains information about the last time that an IAM role was used. This
    -- includes the date and time and the Region in which the role was last
    -- used. Activity is only reported for the trailing 400 days. This period
    -- can be shorter if your Region began supporting these features within the
    -- last year. The role might have been used more than 400 days ago. For
    -- more information, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_access-advisor.html#access-advisor_tracking-period Regions where data is tracked>
    -- in the /IAM User Guide/.
    Role -> Maybe RoleLastUsed
roleLastUsed :: Prelude.Maybe RoleLastUsed,
    -- | A list of tags that are attached to 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/.
    Role -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The path to the role. For more information about paths, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
    -- in the /IAM User Guide/.
    Role -> Text
path :: Prelude.Text,
    -- | The friendly name that identifies the role.
    Role -> Text
roleName :: Prelude.Text,
    -- | The stable and unique string identifying the role. For more information
    -- about IDs, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
    -- in the /IAM User Guide/.
    Role -> Text
roleId :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) specifying the role. For more information
    -- about ARNs and how to use them in policies, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
    -- in the /IAM User Guide/ guide.
    Role -> Text
arn :: Prelude.Text,
    -- | The date and time, in
    -- <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the
    -- role was created.
    Role -> ISO8601
createDate :: Data.ISO8601
  }
  deriving (Role -> Role -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c== :: Role -> Role -> Bool
Prelude.Eq, ReadPrec [Role]
ReadPrec Role
Int -> ReadS Role
ReadS [Role]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Role]
$creadListPrec :: ReadPrec [Role]
readPrec :: ReadPrec Role
$creadPrec :: ReadPrec Role
readList :: ReadS [Role]
$creadList :: ReadS [Role]
readsPrec :: Int -> ReadS Role
$creadsPrec :: Int -> ReadS Role
Prelude.Read, Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Role] -> ShowS
$cshowList :: [Role] -> ShowS
show :: Role -> String
$cshow :: Role -> String
showsPrec :: Int -> Role -> ShowS
$cshowsPrec :: Int -> Role -> ShowS
Prelude.Show, forall x. Rep Role x -> Role
forall x. Role -> Rep Role x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Role x -> Role
$cfrom :: forall x. Role -> Rep Role x
Prelude.Generic)

-- |
-- Create a value of 'Role' 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:
--
-- 'assumeRolePolicyDocument', 'role_assumeRolePolicyDocument' - The policy that grants an entity permission to assume the role.
--
-- 'description', 'role_description' - A description of the role that you provide.
--
-- 'maxSessionDuration', 'role_maxSessionDuration' - The maximum session duration (in seconds) for the specified role. Anyone
-- who uses the CLI, or API to assume the role can specify the duration
-- using the optional @DurationSeconds@ API parameter or @duration-seconds@
-- CLI parameter.
--
-- 'permissionsBoundary', 'role_permissionsBoundary' - The ARN of the policy used to set the permissions boundary for the role.
--
-- For more information about permissions boundaries, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_boundaries.html Permissions boundaries for IAM identities>
-- in the /IAM User Guide/.
--
-- 'roleLastUsed', 'role_roleLastUsed' - Contains information about the last time that an IAM role was used. This
-- includes the date and time and the Region in which the role was last
-- used. Activity is only reported for the trailing 400 days. This period
-- can be shorter if your Region began supporting these features within the
-- last year. The role might have been used more than 400 days ago. For
-- more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_access-advisor.html#access-advisor_tracking-period Regions where data is tracked>
-- in the /IAM User Guide/.
--
-- 'tags', 'role_tags' - A list of tags that are attached to 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/.
--
-- 'path', 'role_path' - The path to the role. For more information about paths, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
--
-- 'roleName', 'role_roleName' - The friendly name that identifies the role.
--
-- 'roleId', 'role_roleId' - The stable and unique string identifying the role. For more information
-- about IDs, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
--
-- 'arn', 'role_arn' - The Amazon Resource Name (ARN) specifying the role. For more information
-- about ARNs and how to use them in policies, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/ guide.
--
-- 'createDate', 'role_createDate' - The date and time, in
-- <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the
-- role was created.
newRole ::
  -- | 'path'
  Prelude.Text ->
  -- | 'roleName'
  Prelude.Text ->
  -- | 'roleId'
  Prelude.Text ->
  -- | 'arn'
  Prelude.Text ->
  -- | 'createDate'
  Prelude.UTCTime ->
  Role
newRole :: Text -> Text -> Text -> Text -> UTCTime -> Role
newRole Text
pPath_ Text
pRoleName_ Text
pRoleId_ Text
pArn_ UTCTime
pCreateDate_ =
  Role'
    { $sel:assumeRolePolicyDocument:Role' :: Maybe Text
assumeRolePolicyDocument = forall a. Maybe a
Prelude.Nothing,
      $sel:description:Role' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:maxSessionDuration:Role' :: Maybe Natural
maxSessionDuration = forall a. Maybe a
Prelude.Nothing,
      $sel:permissionsBoundary:Role' :: Maybe AttachedPermissionsBoundary
permissionsBoundary = forall a. Maybe a
Prelude.Nothing,
      $sel:roleLastUsed:Role' :: Maybe RoleLastUsed
roleLastUsed = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:Role' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:path:Role' :: Text
path = Text
pPath_,
      $sel:roleName:Role' :: Text
roleName = Text
pRoleName_,
      $sel:roleId:Role' :: Text
roleId = Text
pRoleId_,
      $sel:arn:Role' :: Text
arn = Text
pArn_,
      $sel:createDate:Role' :: ISO8601
createDate = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreateDate_
    }

-- | The policy that grants an entity permission to assume the role.
role_assumeRolePolicyDocument :: Lens.Lens' Role (Prelude.Maybe Prelude.Text)
role_assumeRolePolicyDocument :: Lens' Role (Maybe Text)
role_assumeRolePolicyDocument = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Role' {Maybe Text
assumeRolePolicyDocument :: Maybe Text
$sel:assumeRolePolicyDocument:Role' :: Role -> Maybe Text
assumeRolePolicyDocument} -> Maybe Text
assumeRolePolicyDocument) (\s :: Role
s@Role' {} Maybe Text
a -> Role
s {$sel:assumeRolePolicyDocument:Role' :: Maybe Text
assumeRolePolicyDocument = Maybe Text
a} :: Role)

-- | A description of the role that you provide.
role_description :: Lens.Lens' Role (Prelude.Maybe Prelude.Text)
role_description :: Lens' Role (Maybe Text)
role_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Role' {Maybe Text
description :: Maybe Text
$sel:description:Role' :: Role -> Maybe Text
description} -> Maybe Text
description) (\s :: Role
s@Role' {} Maybe Text
a -> Role
s {$sel:description:Role' :: Maybe Text
description = Maybe Text
a} :: Role)

-- | The maximum session duration (in seconds) for the specified role. Anyone
-- who uses the CLI, or API to assume the role can specify the duration
-- using the optional @DurationSeconds@ API parameter or @duration-seconds@
-- CLI parameter.
role_maxSessionDuration :: Lens.Lens' Role (Prelude.Maybe Prelude.Natural)
role_maxSessionDuration :: Lens' Role (Maybe Natural)
role_maxSessionDuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Role' {Maybe Natural
maxSessionDuration :: Maybe Natural
$sel:maxSessionDuration:Role' :: Role -> Maybe Natural
maxSessionDuration} -> Maybe Natural
maxSessionDuration) (\s :: Role
s@Role' {} Maybe Natural
a -> Role
s {$sel:maxSessionDuration:Role' :: Maybe Natural
maxSessionDuration = Maybe Natural
a} :: Role)

-- | The ARN of the policy used to set the permissions boundary for the role.
--
-- For more information about permissions boundaries, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_boundaries.html Permissions boundaries for IAM identities>
-- in the /IAM User Guide/.
role_permissionsBoundary :: Lens.Lens' Role (Prelude.Maybe AttachedPermissionsBoundary)
role_permissionsBoundary :: Lens' Role (Maybe AttachedPermissionsBoundary)
role_permissionsBoundary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Role' {Maybe AttachedPermissionsBoundary
permissionsBoundary :: Maybe AttachedPermissionsBoundary
$sel:permissionsBoundary:Role' :: Role -> Maybe AttachedPermissionsBoundary
permissionsBoundary} -> Maybe AttachedPermissionsBoundary
permissionsBoundary) (\s :: Role
s@Role' {} Maybe AttachedPermissionsBoundary
a -> Role
s {$sel:permissionsBoundary:Role' :: Maybe AttachedPermissionsBoundary
permissionsBoundary = Maybe AttachedPermissionsBoundary
a} :: Role)

-- | Contains information about the last time that an IAM role was used. This
-- includes the date and time and the Region in which the role was last
-- used. Activity is only reported for the trailing 400 days. This period
-- can be shorter if your Region began supporting these features within the
-- last year. The role might have been used more than 400 days ago. For
-- more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_access-advisor.html#access-advisor_tracking-period Regions where data is tracked>
-- in the /IAM User Guide/.
role_roleLastUsed :: Lens.Lens' Role (Prelude.Maybe RoleLastUsed)
role_roleLastUsed :: Lens' Role (Maybe RoleLastUsed)
role_roleLastUsed = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Role' {Maybe RoleLastUsed
roleLastUsed :: Maybe RoleLastUsed
$sel:roleLastUsed:Role' :: Role -> Maybe RoleLastUsed
roleLastUsed} -> Maybe RoleLastUsed
roleLastUsed) (\s :: Role
s@Role' {} Maybe RoleLastUsed
a -> Role
s {$sel:roleLastUsed:Role' :: Maybe RoleLastUsed
roleLastUsed = Maybe RoleLastUsed
a} :: Role)

-- | A list of tags that are attached to 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/.
role_tags :: Lens.Lens' Role (Prelude.Maybe [Tag])
role_tags :: Lens' Role (Maybe [Tag])
role_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Role' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:Role' :: Role -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: Role
s@Role' {} Maybe [Tag]
a -> Role
s {$sel:tags:Role' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: Role) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The path to the role. For more information about paths, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
role_path :: Lens.Lens' Role Prelude.Text
role_path :: Lens' Role Text
role_path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Role' {Text
path :: Text
$sel:path:Role' :: Role -> Text
path} -> Text
path) (\s :: Role
s@Role' {} Text
a -> Role
s {$sel:path:Role' :: Text
path = Text
a} :: Role)

-- | The friendly name that identifies the role.
role_roleName :: Lens.Lens' Role Prelude.Text
role_roleName :: Lens' Role Text
role_roleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Role' {Text
roleName :: Text
$sel:roleName:Role' :: Role -> Text
roleName} -> Text
roleName) (\s :: Role
s@Role' {} Text
a -> Role
s {$sel:roleName:Role' :: Text
roleName = Text
a} :: Role)

-- | The stable and unique string identifying the role. For more information
-- about IDs, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
role_roleId :: Lens.Lens' Role Prelude.Text
role_roleId :: Lens' Role Text
role_roleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Role' {Text
roleId :: Text
$sel:roleId:Role' :: Role -> Text
roleId} -> Text
roleId) (\s :: Role
s@Role' {} Text
a -> Role
s {$sel:roleId:Role' :: Text
roleId = Text
a} :: Role)

-- | The Amazon Resource Name (ARN) specifying the role. For more information
-- about ARNs and how to use them in policies, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/ guide.
role_arn :: Lens.Lens' Role Prelude.Text
role_arn :: Lens' Role Text
role_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Role' {Text
arn :: Text
$sel:arn:Role' :: Role -> Text
arn} -> Text
arn) (\s :: Role
s@Role' {} Text
a -> Role
s {$sel:arn:Role' :: Text
arn = Text
a} :: Role)

-- | The date and time, in
-- <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the
-- role was created.
role_createDate :: Lens.Lens' Role Prelude.UTCTime
role_createDate :: Lens' Role UTCTime
role_createDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Role' {ISO8601
createDate :: ISO8601
$sel:createDate:Role' :: Role -> ISO8601
createDate} -> ISO8601
createDate) (\s :: Role
s@Role' {} ISO8601
a -> Role
s {$sel:createDate:Role' :: ISO8601
createDate = ISO8601
a} :: Role) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Data.FromXML Role where
  parseXML :: [Node] -> Either String Role
parseXML [Node]
x =
    Maybe Text
-> Maybe Text
-> Maybe Natural
-> Maybe AttachedPermissionsBoundary
-> Maybe RoleLastUsed
-> Maybe [Tag]
-> Text
-> Text
-> Text
-> Text
-> ISO8601
-> Role
Role'
      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
"AssumeRolePolicyDocument")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Description")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"MaxSessionDuration")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"PermissionsBoundary")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"RoleLastUsed")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Tags"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Path")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"RoleName")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"RoleId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Arn")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"CreateDate")

instance Prelude.Hashable Role where
  hashWithSalt :: Int -> Role -> Int
hashWithSalt Int
_salt Role' {Maybe Natural
Maybe [Tag]
Maybe Text
Maybe AttachedPermissionsBoundary
Maybe RoleLastUsed
Text
ISO8601
createDate :: ISO8601
arn :: Text
roleId :: Text
roleName :: Text
path :: Text
tags :: Maybe [Tag]
roleLastUsed :: Maybe RoleLastUsed
permissionsBoundary :: Maybe AttachedPermissionsBoundary
maxSessionDuration :: Maybe Natural
description :: Maybe Text
assumeRolePolicyDocument :: Maybe Text
$sel:createDate:Role' :: Role -> ISO8601
$sel:arn:Role' :: Role -> Text
$sel:roleId:Role' :: Role -> Text
$sel:roleName:Role' :: Role -> Text
$sel:path:Role' :: Role -> Text
$sel:tags:Role' :: Role -> Maybe [Tag]
$sel:roleLastUsed:Role' :: Role -> Maybe RoleLastUsed
$sel:permissionsBoundary:Role' :: Role -> Maybe AttachedPermissionsBoundary
$sel:maxSessionDuration:Role' :: Role -> Maybe Natural
$sel:description:Role' :: Role -> Maybe Text
$sel:assumeRolePolicyDocument:Role' :: Role -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
assumeRolePolicyDocument
      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` Maybe AttachedPermissionsBoundary
permissionsBoundary
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RoleLastUsed
roleLastUsed
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
path
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
createDate

instance Prelude.NFData Role where
  rnf :: Role -> ()
rnf Role' {Maybe Natural
Maybe [Tag]
Maybe Text
Maybe AttachedPermissionsBoundary
Maybe RoleLastUsed
Text
ISO8601
createDate :: ISO8601
arn :: Text
roleId :: Text
roleName :: Text
path :: Text
tags :: Maybe [Tag]
roleLastUsed :: Maybe RoleLastUsed
permissionsBoundary :: Maybe AttachedPermissionsBoundary
maxSessionDuration :: Maybe Natural
description :: Maybe Text
assumeRolePolicyDocument :: Maybe Text
$sel:createDate:Role' :: Role -> ISO8601
$sel:arn:Role' :: Role -> Text
$sel:roleId:Role' :: Role -> Text
$sel:roleName:Role' :: Role -> Text
$sel:path:Role' :: Role -> Text
$sel:tags:Role' :: Role -> Maybe [Tag]
$sel:roleLastUsed:Role' :: Role -> Maybe RoleLastUsed
$sel:permissionsBoundary:Role' :: Role -> Maybe AttachedPermissionsBoundary
$sel:maxSessionDuration:Role' :: Role -> Maybe Natural
$sel:description:Role' :: Role -> Maybe Text
$sel:assumeRolePolicyDocument:Role' :: Role -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
assumeRolePolicyDocument
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe AttachedPermissionsBoundary
permissionsBoundary
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RoleLastUsed
roleLastUsed
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
path
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
roleId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
createDate