{-# 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.CreateRole
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new role for your Amazon Web Services account. For more
-- information about roles, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/WorkingWithRoles.html IAM roles>.
-- For information about quotas for role names and the number of roles you
-- can create, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_iam-quotas.html IAM and STS quotas>
-- in the /IAM User Guide/.
module Amazonka.IAM.CreateRole
  ( -- * Creating a Request
    CreateRole (..),
    newCreateRole,

    -- * Request Lenses
    createRole_description,
    createRole_maxSessionDuration,
    createRole_path,
    createRole_permissionsBoundary,
    createRole_tags,
    createRole_roleName,
    createRole_assumeRolePolicyDocument,

    -- * Destructuring the Response
    CreateRoleResponse (..),
    newCreateRoleResponse,

    -- * Response Lenses
    createRoleResponse_httpStatus,
    createRoleResponse_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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateRole' smart constructor.
data CreateRole = CreateRole'
  { -- | A description of the role.
    CreateRole -> 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/.
    CreateRole -> Maybe Natural
maxSessionDuration :: Prelude.Maybe Prelude.Natural,
    -- | 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/.
    --
    -- This parameter is optional. If it is not included, it defaults to a
    -- slash (\/).
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of either a forward slash (\/) by itself or a string that
    -- must begin and end with forward slashes. In addition, it can contain any
    -- ASCII character from the ! (@\\u0021@) through the DEL character
    -- (@\\u007F@), including most punctuation characters, digits, and upper
    -- and lowercased letters.
    CreateRole -> Maybe Text
path :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the policy that is used to set the permissions boundary for
    -- the role.
    CreateRole -> Maybe Text
permissionsBoundary :: Prelude.Maybe Prelude.Text,
    -- | A list of tags that you want to attach to the new role. Each tag
    -- consists of a key name and an associated value. 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/.
    --
    -- 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.
    CreateRole -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the role to create.
    --
    -- IAM user, group, role, and policy names must be unique within the
    -- account. Names are not distinguished by case. For example, you cannot
    -- create resources named both \"MyResource\" and \"myresource\".
    CreateRole -> Text
roleName :: Prelude.Text,
    -- | The trust relationship policy document that grants an entity permission
    -- to assume the role.
    --
    -- In IAM, you must provide a JSON policy that has been converted to a
    -- string. However, for CloudFormation templates formatted in YAML, you can
    -- provide the policy in JSON or YAML format. CloudFormation always
    -- converts a YAML policy to JSON format before submitting it to IAM.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
    -- this parameter is a string of characters consisting of the following:
    --
    -- -   Any printable ASCII character ranging from the space character
    --     (@\\u0020@) through the end of the ASCII character range
    --
    -- -   The printable characters in the Basic Latin and Latin-1 Supplement
    --     character set (through @\\u00FF@)
    --
    -- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
    --     carriage return (@\\u000D@)
    --
    -- Upon success, the response includes the same trust policy in JSON
    -- format.
    CreateRole -> Text
assumeRolePolicyDocument :: Prelude.Text
  }
  deriving (CreateRole -> CreateRole -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateRole -> CreateRole -> Bool
$c/= :: CreateRole -> CreateRole -> Bool
== :: CreateRole -> CreateRole -> Bool
$c== :: CreateRole -> CreateRole -> Bool
Prelude.Eq, ReadPrec [CreateRole]
ReadPrec CreateRole
Int -> ReadS CreateRole
ReadS [CreateRole]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateRole]
$creadListPrec :: ReadPrec [CreateRole]
readPrec :: ReadPrec CreateRole
$creadPrec :: ReadPrec CreateRole
readList :: ReadS [CreateRole]
$creadList :: ReadS [CreateRole]
readsPrec :: Int -> ReadS CreateRole
$creadsPrec :: Int -> ReadS CreateRole
Prelude.Read, Int -> CreateRole -> ShowS
[CreateRole] -> ShowS
CreateRole -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateRole] -> ShowS
$cshowList :: [CreateRole] -> ShowS
show :: CreateRole -> String
$cshow :: CreateRole -> String
showsPrec :: Int -> CreateRole -> ShowS
$cshowsPrec :: Int -> CreateRole -> ShowS
Prelude.Show, forall x. Rep CreateRole x -> CreateRole
forall x. CreateRole -> Rep CreateRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateRole x -> CreateRole
$cfrom :: forall x. CreateRole -> Rep CreateRole x
Prelude.Generic)

-- |
-- Create a value of 'CreateRole' 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', 'createRole_description' - A description of the role.
--
-- 'maxSessionDuration', 'createRole_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/.
--
-- 'path', 'createRole_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/.
--
-- This parameter is optional. If it is not included, it defaults to a
-- slash (\/).
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of either a forward slash (\/) by itself or a string that
-- must begin and end with forward slashes. In addition, it can contain any
-- ASCII character from the ! (@\\u0021@) through the DEL character
-- (@\\u007F@), including most punctuation characters, digits, and upper
-- and lowercased letters.
--
-- 'permissionsBoundary', 'createRole_permissionsBoundary' - The ARN of the policy that is used to set the permissions boundary for
-- the role.
--
-- 'tags', 'createRole_tags' - A list of tags that you want to attach to the new role. Each tag
-- consists of a key name and an associated value. 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/.
--
-- 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.
--
-- 'roleName', 'createRole_roleName' - The name of the role to create.
--
-- IAM user, group, role, and policy names must be unique within the
-- account. Names are not distinguished by case. For example, you cannot
-- create resources named both \"MyResource\" and \"myresource\".
--
-- 'assumeRolePolicyDocument', 'createRole_assumeRolePolicyDocument' - The trust relationship policy document that grants an entity permission
-- to assume the role.
--
-- In IAM, you must provide a JSON policy that has been converted to a
-- string. However, for CloudFormation templates formatted in YAML, you can
-- provide the policy in JSON or YAML format. CloudFormation always
-- converts a YAML policy to JSON format before submitting it to IAM.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
-- this parameter is a string of characters consisting of the following:
--
-- -   Any printable ASCII character ranging from the space character
--     (@\\u0020@) through the end of the ASCII character range
--
-- -   The printable characters in the Basic Latin and Latin-1 Supplement
--     character set (through @\\u00FF@)
--
-- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
--     carriage return (@\\u000D@)
--
-- Upon success, the response includes the same trust policy in JSON
-- format.
newCreateRole ::
  -- | 'roleName'
  Prelude.Text ->
  -- | 'assumeRolePolicyDocument'
  Prelude.Text ->
  CreateRole
newCreateRole :: Text -> Text -> CreateRole
newCreateRole Text
pRoleName_ Text
pAssumeRolePolicyDocument_ =
  CreateRole'
    { $sel:description:CreateRole' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:maxSessionDuration:CreateRole' :: Maybe Natural
maxSessionDuration = forall a. Maybe a
Prelude.Nothing,
      $sel:path:CreateRole' :: Maybe Text
path = forall a. Maybe a
Prelude.Nothing,
      $sel:permissionsBoundary:CreateRole' :: Maybe Text
permissionsBoundary = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateRole' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:roleName:CreateRole' :: Text
roleName = Text
pRoleName_,
      $sel:assumeRolePolicyDocument:CreateRole' :: Text
assumeRolePolicyDocument =
        Text
pAssumeRolePolicyDocument_
    }

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

-- | 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/.
createRole_maxSessionDuration :: Lens.Lens' CreateRole (Prelude.Maybe Prelude.Natural)
createRole_maxSessionDuration :: Lens' CreateRole (Maybe Natural)
createRole_maxSessionDuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRole' {Maybe Natural
maxSessionDuration :: Maybe Natural
$sel:maxSessionDuration:CreateRole' :: CreateRole -> Maybe Natural
maxSessionDuration} -> Maybe Natural
maxSessionDuration) (\s :: CreateRole
s@CreateRole' {} Maybe Natural
a -> CreateRole
s {$sel:maxSessionDuration:CreateRole' :: Maybe Natural
maxSessionDuration = Maybe Natural
a} :: CreateRole)

-- | 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/.
--
-- This parameter is optional. If it is not included, it defaults to a
-- slash (\/).
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of either a forward slash (\/) by itself or a string that
-- must begin and end with forward slashes. In addition, it can contain any
-- ASCII character from the ! (@\\u0021@) through the DEL character
-- (@\\u007F@), including most punctuation characters, digits, and upper
-- and lowercased letters.
createRole_path :: Lens.Lens' CreateRole (Prelude.Maybe Prelude.Text)
createRole_path :: Lens' CreateRole (Maybe Text)
createRole_path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRole' {Maybe Text
path :: Maybe Text
$sel:path:CreateRole' :: CreateRole -> Maybe Text
path} -> Maybe Text
path) (\s :: CreateRole
s@CreateRole' {} Maybe Text
a -> CreateRole
s {$sel:path:CreateRole' :: Maybe Text
path = Maybe Text
a} :: CreateRole)

-- | The ARN of the policy that is used to set the permissions boundary for
-- the role.
createRole_permissionsBoundary :: Lens.Lens' CreateRole (Prelude.Maybe Prelude.Text)
createRole_permissionsBoundary :: Lens' CreateRole (Maybe Text)
createRole_permissionsBoundary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRole' {Maybe Text
permissionsBoundary :: Maybe Text
$sel:permissionsBoundary:CreateRole' :: CreateRole -> Maybe Text
permissionsBoundary} -> Maybe Text
permissionsBoundary) (\s :: CreateRole
s@CreateRole' {} Maybe Text
a -> CreateRole
s {$sel:permissionsBoundary:CreateRole' :: Maybe Text
permissionsBoundary = Maybe Text
a} :: CreateRole)

-- | A list of tags that you want to attach to the new role. Each tag
-- consists of a key name and an associated value. 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/.
--
-- 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.
createRole_tags :: Lens.Lens' CreateRole (Prelude.Maybe [Tag])
createRole_tags :: Lens' CreateRole (Maybe [Tag])
createRole_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRole' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateRole' :: CreateRole -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateRole
s@CreateRole' {} Maybe [Tag]
a -> CreateRole
s {$sel:tags:CreateRole' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateRole) 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 name of the role to create.
--
-- IAM user, group, role, and policy names must be unique within the
-- account. Names are not distinguished by case. For example, you cannot
-- create resources named both \"MyResource\" and \"myresource\".
createRole_roleName :: Lens.Lens' CreateRole Prelude.Text
createRole_roleName :: Lens' CreateRole Text
createRole_roleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRole' {Text
roleName :: Text
$sel:roleName:CreateRole' :: CreateRole -> Text
roleName} -> Text
roleName) (\s :: CreateRole
s@CreateRole' {} Text
a -> CreateRole
s {$sel:roleName:CreateRole' :: Text
roleName = Text
a} :: CreateRole)

-- | The trust relationship policy document that grants an entity permission
-- to assume the role.
--
-- In IAM, you must provide a JSON policy that has been converted to a
-- string. However, for CloudFormation templates formatted in YAML, you can
-- provide the policy in JSON or YAML format. CloudFormation always
-- converts a YAML policy to JSON format before submitting it to IAM.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
-- this parameter is a string of characters consisting of the following:
--
-- -   Any printable ASCII character ranging from the space character
--     (@\\u0020@) through the end of the ASCII character range
--
-- -   The printable characters in the Basic Latin and Latin-1 Supplement
--     character set (through @\\u00FF@)
--
-- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
--     carriage return (@\\u000D@)
--
-- Upon success, the response includes the same trust policy in JSON
-- format.
createRole_assumeRolePolicyDocument :: Lens.Lens' CreateRole Prelude.Text
createRole_assumeRolePolicyDocument :: Lens' CreateRole Text
createRole_assumeRolePolicyDocument = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRole' {Text
assumeRolePolicyDocument :: Text
$sel:assumeRolePolicyDocument:CreateRole' :: CreateRole -> Text
assumeRolePolicyDocument} -> Text
assumeRolePolicyDocument) (\s :: CreateRole
s@CreateRole' {} Text
a -> CreateRole
s {$sel:assumeRolePolicyDocument:CreateRole' :: Text
assumeRolePolicyDocument = Text
a} :: CreateRole)

instance Core.AWSRequest CreateRole where
  type AWSResponse CreateRole = CreateRoleResponse
  request :: (Service -> Service) -> CreateRole -> Request CreateRole
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 CreateRole
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateRole)))
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
"CreateRoleResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> Role -> CreateRoleResponse
CreateRoleResponse'
            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))
            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
"Role")
      )

instance Prelude.Hashable CreateRole where
  hashWithSalt :: Int -> CreateRole -> Int
hashWithSalt Int
_salt CreateRole' {Maybe Natural
Maybe [Tag]
Maybe Text
Text
assumeRolePolicyDocument :: Text
roleName :: Text
tags :: Maybe [Tag]
permissionsBoundary :: Maybe Text
path :: Maybe Text
maxSessionDuration :: Maybe Natural
description :: Maybe Text
$sel:assumeRolePolicyDocument:CreateRole' :: CreateRole -> Text
$sel:roleName:CreateRole' :: CreateRole -> Text
$sel:tags:CreateRole' :: CreateRole -> Maybe [Tag]
$sel:permissionsBoundary:CreateRole' :: CreateRole -> Maybe Text
$sel:path:CreateRole' :: CreateRole -> Maybe Text
$sel:maxSessionDuration:CreateRole' :: CreateRole -> Maybe Natural
$sel:description:CreateRole' :: CreateRole -> 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` Maybe Text
path
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
permissionsBoundary
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
assumeRolePolicyDocument

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

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

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

instance Data.ToQuery CreateRole where
  toQuery :: CreateRole -> QueryString
toQuery CreateRole' {Maybe Natural
Maybe [Tag]
Maybe Text
Text
assumeRolePolicyDocument :: Text
roleName :: Text
tags :: Maybe [Tag]
permissionsBoundary :: Maybe Text
path :: Maybe Text
maxSessionDuration :: Maybe Natural
description :: Maybe Text
$sel:assumeRolePolicyDocument:CreateRole' :: CreateRole -> Text
$sel:roleName:CreateRole' :: CreateRole -> Text
$sel:tags:CreateRole' :: CreateRole -> Maybe [Tag]
$sel:permissionsBoundary:CreateRole' :: CreateRole -> Maybe Text
$sel:path:CreateRole' :: CreateRole -> Maybe Text
$sel:maxSessionDuration:CreateRole' :: CreateRole -> Maybe Natural
$sel:description:CreateRole' :: CreateRole -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateRole" :: 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
"Path" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
path,
        ByteString
"PermissionsBoundary" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
permissionsBoundary,
        ByteString
"Tags"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"RoleName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
roleName,
        ByteString
"AssumeRolePolicyDocument"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
assumeRolePolicyDocument
      ]

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

-- |
-- Create a value of 'CreateRoleResponse' 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', 'createRoleResponse_httpStatus' - The response's http status code.
--
-- 'role'', 'createRoleResponse_role' - A structure containing details about the new role.
newCreateRoleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'role''
  Role ->
  CreateRoleResponse
newCreateRoleResponse :: Int -> Role -> CreateRoleResponse
newCreateRoleResponse Int
pHttpStatus_ Role
pRole_ =
  CreateRoleResponse'
    { $sel:httpStatus:CreateRoleResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:role':CreateRoleResponse' :: Role
role' = Role
pRole_
    }

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

-- | A structure containing details about the new role.
createRoleResponse_role :: Lens.Lens' CreateRoleResponse Role
createRoleResponse_role :: Lens' CreateRoleResponse Role
createRoleResponse_role = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRoleResponse' {Role
role' :: Role
$sel:role':CreateRoleResponse' :: CreateRoleResponse -> Role
role'} -> Role
role') (\s :: CreateRoleResponse
s@CreateRoleResponse' {} Role
a -> CreateRoleResponse
s {$sel:role':CreateRoleResponse' :: Role
role' = Role
a} :: CreateRoleResponse)

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