{-# 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.CreateSAMLProvider
-- 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 an IAM resource that describes an identity provider (IdP) that
-- supports SAML 2.0.
--
-- The SAML provider resource that you create with this operation can be
-- used as a principal in an IAM role\'s trust policy. Such a policy can
-- enable federated users who sign in using the SAML IdP to assume the
-- role. You can create an IAM role that supports Web-based single sign-on
-- (SSO) to the Amazon Web Services Management Console or one that supports
-- API access to Amazon Web Services.
--
-- When you create the SAML provider resource, you upload a SAML metadata
-- document that you get from your IdP. That document includes the
-- issuer\'s name, expiration information, and keys that can be used to
-- validate the SAML authentication response (assertions) that the IdP
-- sends. You must generate the metadata document using the identity
-- management software that is used as your organization\'s IdP.
--
-- This operation requires
-- <https://docs.aws.amazon.com/general/latest/gr/signature-version-4.html Signature Version 4>.
--
-- For more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles_providers_enable-console-saml.html Enabling SAML 2.0 federated users to access the Amazon Web Services Management Console>
-- and
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles_providers_saml.html About SAML 2.0-based federation>
-- in the /IAM User Guide/.
module Amazonka.IAM.CreateSAMLProvider
  ( -- * Creating a Request
    CreateSAMLProvider (..),
    newCreateSAMLProvider,

    -- * Request Lenses
    createSAMLProvider_tags,
    createSAMLProvider_sAMLMetadataDocument,
    createSAMLProvider_name,

    -- * Destructuring the Response
    CreateSAMLProviderResponse (..),
    newCreateSAMLProviderResponse,

    -- * Response Lenses
    createSAMLProviderResponse_sAMLProviderArn,
    createSAMLProviderResponse_tags,
    createSAMLProviderResponse_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:/ 'newCreateSAMLProvider' smart constructor.
data CreateSAMLProvider = CreateSAMLProvider'
  { -- | A list of tags that you want to attach to the new IAM SAML provider.
    -- 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.
    CreateSAMLProvider -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | An XML document generated by an identity provider (IdP) that supports
    -- SAML 2.0. The document includes the issuer\'s name, expiration
    -- information, and keys that can be used to validate the SAML
    -- authentication response (assertions) that are received from the IdP. You
    -- must generate the metadata document using the identity management
    -- software that is used as your organization\'s IdP.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles_providers_saml.html About SAML 2.0-based federation>
    -- in the /IAM User Guide/
    CreateSAMLProvider -> Text
sAMLMetadataDocument :: Prelude.Text,
    -- | The name of the provider to create.
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of upper and lowercase alphanumeric characters with no
    -- spaces. You can also include any of the following characters: _+=,.\@-
    CreateSAMLProvider -> Text
name :: Prelude.Text
  }
  deriving (CreateSAMLProvider -> CreateSAMLProvider -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSAMLProvider -> CreateSAMLProvider -> Bool
$c/= :: CreateSAMLProvider -> CreateSAMLProvider -> Bool
== :: CreateSAMLProvider -> CreateSAMLProvider -> Bool
$c== :: CreateSAMLProvider -> CreateSAMLProvider -> Bool
Prelude.Eq, ReadPrec [CreateSAMLProvider]
ReadPrec CreateSAMLProvider
Int -> ReadS CreateSAMLProvider
ReadS [CreateSAMLProvider]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSAMLProvider]
$creadListPrec :: ReadPrec [CreateSAMLProvider]
readPrec :: ReadPrec CreateSAMLProvider
$creadPrec :: ReadPrec CreateSAMLProvider
readList :: ReadS [CreateSAMLProvider]
$creadList :: ReadS [CreateSAMLProvider]
readsPrec :: Int -> ReadS CreateSAMLProvider
$creadsPrec :: Int -> ReadS CreateSAMLProvider
Prelude.Read, Int -> CreateSAMLProvider -> ShowS
[CreateSAMLProvider] -> ShowS
CreateSAMLProvider -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSAMLProvider] -> ShowS
$cshowList :: [CreateSAMLProvider] -> ShowS
show :: CreateSAMLProvider -> String
$cshow :: CreateSAMLProvider -> String
showsPrec :: Int -> CreateSAMLProvider -> ShowS
$cshowsPrec :: Int -> CreateSAMLProvider -> ShowS
Prelude.Show, forall x. Rep CreateSAMLProvider x -> CreateSAMLProvider
forall x. CreateSAMLProvider -> Rep CreateSAMLProvider x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSAMLProvider x -> CreateSAMLProvider
$cfrom :: forall x. CreateSAMLProvider -> Rep CreateSAMLProvider x
Prelude.Generic)

-- |
-- Create a value of 'CreateSAMLProvider' 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:
--
-- 'tags', 'createSAMLProvider_tags' - A list of tags that you want to attach to the new IAM SAML provider.
-- 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.
--
-- 'sAMLMetadataDocument', 'createSAMLProvider_sAMLMetadataDocument' - An XML document generated by an identity provider (IdP) that supports
-- SAML 2.0. The document includes the issuer\'s name, expiration
-- information, and keys that can be used to validate the SAML
-- authentication response (assertions) that are received from the IdP. You
-- must generate the metadata document using the identity management
-- software that is used as your organization\'s IdP.
--
-- For more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles_providers_saml.html About SAML 2.0-based federation>
-- in the /IAM User Guide/
--
-- 'name', 'createSAMLProvider_name' - The name of the provider to create.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
newCreateSAMLProvider ::
  -- | 'sAMLMetadataDocument'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  CreateSAMLProvider
newCreateSAMLProvider :: Text -> Text -> CreateSAMLProvider
newCreateSAMLProvider Text
pSAMLMetadataDocument_ Text
pName_ =
  CreateSAMLProvider'
    { $sel:tags:CreateSAMLProvider' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:sAMLMetadataDocument:CreateSAMLProvider' :: Text
sAMLMetadataDocument = Text
pSAMLMetadataDocument_,
      $sel:name:CreateSAMLProvider' :: Text
name = Text
pName_
    }

-- | A list of tags that you want to attach to the new IAM SAML provider.
-- 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.
createSAMLProvider_tags :: Lens.Lens' CreateSAMLProvider (Prelude.Maybe [Tag])
createSAMLProvider_tags :: Lens' CreateSAMLProvider (Maybe [Tag])
createSAMLProvider_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSAMLProvider' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateSAMLProvider' :: CreateSAMLProvider -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateSAMLProvider
s@CreateSAMLProvider' {} Maybe [Tag]
a -> CreateSAMLProvider
s {$sel:tags:CreateSAMLProvider' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateSAMLProvider) 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

-- | An XML document generated by an identity provider (IdP) that supports
-- SAML 2.0. The document includes the issuer\'s name, expiration
-- information, and keys that can be used to validate the SAML
-- authentication response (assertions) that are received from the IdP. You
-- must generate the metadata document using the identity management
-- software that is used as your organization\'s IdP.
--
-- For more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles_providers_saml.html About SAML 2.0-based federation>
-- in the /IAM User Guide/
createSAMLProvider_sAMLMetadataDocument :: Lens.Lens' CreateSAMLProvider Prelude.Text
createSAMLProvider_sAMLMetadataDocument :: Lens' CreateSAMLProvider Text
createSAMLProvider_sAMLMetadataDocument = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSAMLProvider' {Text
sAMLMetadataDocument :: Text
$sel:sAMLMetadataDocument:CreateSAMLProvider' :: CreateSAMLProvider -> Text
sAMLMetadataDocument} -> Text
sAMLMetadataDocument) (\s :: CreateSAMLProvider
s@CreateSAMLProvider' {} Text
a -> CreateSAMLProvider
s {$sel:sAMLMetadataDocument:CreateSAMLProvider' :: Text
sAMLMetadataDocument = Text
a} :: CreateSAMLProvider)

-- | The name of the provider to create.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
createSAMLProvider_name :: Lens.Lens' CreateSAMLProvider Prelude.Text
createSAMLProvider_name :: Lens' CreateSAMLProvider Text
createSAMLProvider_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSAMLProvider' {Text
name :: Text
$sel:name:CreateSAMLProvider' :: CreateSAMLProvider -> Text
name} -> Text
name) (\s :: CreateSAMLProvider
s@CreateSAMLProvider' {} Text
a -> CreateSAMLProvider
s {$sel:name:CreateSAMLProvider' :: Text
name = Text
a} :: CreateSAMLProvider)

instance Core.AWSRequest CreateSAMLProvider where
  type
    AWSResponse CreateSAMLProvider =
      CreateSAMLProviderResponse
  request :: (Service -> Service)
-> CreateSAMLProvider -> Request CreateSAMLProvider
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 CreateSAMLProvider
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateSAMLProvider)))
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
"CreateSAMLProviderResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Maybe [Tag] -> Int -> CreateSAMLProviderResponse
CreateSAMLProviderResponse'
            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
"SAMLProviderArn")
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateSAMLProvider where
  hashWithSalt :: Int -> CreateSAMLProvider -> Int
hashWithSalt Int
_salt CreateSAMLProvider' {Maybe [Tag]
Text
name :: Text
sAMLMetadataDocument :: Text
tags :: Maybe [Tag]
$sel:name:CreateSAMLProvider' :: CreateSAMLProvider -> Text
$sel:sAMLMetadataDocument:CreateSAMLProvider' :: CreateSAMLProvider -> Text
$sel:tags:CreateSAMLProvider' :: CreateSAMLProvider -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sAMLMetadataDocument
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateSAMLProvider where
  rnf :: CreateSAMLProvider -> ()
rnf CreateSAMLProvider' {Maybe [Tag]
Text
name :: Text
sAMLMetadataDocument :: Text
tags :: Maybe [Tag]
$sel:name:CreateSAMLProvider' :: CreateSAMLProvider -> Text
$sel:sAMLMetadataDocument:CreateSAMLProvider' :: CreateSAMLProvider -> Text
$sel:tags:CreateSAMLProvider' :: CreateSAMLProvider -> Maybe [Tag]
..} =
    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
sAMLMetadataDocument
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

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

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

instance Data.ToQuery CreateSAMLProvider where
  toQuery :: CreateSAMLProvider -> QueryString
toQuery CreateSAMLProvider' {Maybe [Tag]
Text
name :: Text
sAMLMetadataDocument :: Text
tags :: Maybe [Tag]
$sel:name:CreateSAMLProvider' :: CreateSAMLProvider -> Text
$sel:sAMLMetadataDocument:CreateSAMLProvider' :: CreateSAMLProvider -> Text
$sel:tags:CreateSAMLProvider' :: CreateSAMLProvider -> Maybe [Tag]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateSAMLProvider" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        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
"SAMLMetadataDocument" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
sAMLMetadataDocument,
        ByteString
"Name" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
name
      ]

-- | Contains the response to a successful CreateSAMLProvider request.
--
-- /See:/ 'newCreateSAMLProviderResponse' smart constructor.
data CreateSAMLProviderResponse = CreateSAMLProviderResponse'
  { -- | The Amazon Resource Name (ARN) of the new SAML provider resource in IAM.
    CreateSAMLProviderResponse -> Maybe Text
sAMLProviderArn :: Prelude.Maybe Prelude.Text,
    -- | A list of tags that are attached to the new IAM SAML provider. The
    -- returned list of tags is sorted by tag key. 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/.
    CreateSAMLProviderResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The response's http status code.
    CreateSAMLProviderResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateSAMLProviderResponse -> CreateSAMLProviderResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSAMLProviderResponse -> CreateSAMLProviderResponse -> Bool
$c/= :: CreateSAMLProviderResponse -> CreateSAMLProviderResponse -> Bool
== :: CreateSAMLProviderResponse -> CreateSAMLProviderResponse -> Bool
$c== :: CreateSAMLProviderResponse -> CreateSAMLProviderResponse -> Bool
Prelude.Eq, ReadPrec [CreateSAMLProviderResponse]
ReadPrec CreateSAMLProviderResponse
Int -> ReadS CreateSAMLProviderResponse
ReadS [CreateSAMLProviderResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSAMLProviderResponse]
$creadListPrec :: ReadPrec [CreateSAMLProviderResponse]
readPrec :: ReadPrec CreateSAMLProviderResponse
$creadPrec :: ReadPrec CreateSAMLProviderResponse
readList :: ReadS [CreateSAMLProviderResponse]
$creadList :: ReadS [CreateSAMLProviderResponse]
readsPrec :: Int -> ReadS CreateSAMLProviderResponse
$creadsPrec :: Int -> ReadS CreateSAMLProviderResponse
Prelude.Read, Int -> CreateSAMLProviderResponse -> ShowS
[CreateSAMLProviderResponse] -> ShowS
CreateSAMLProviderResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSAMLProviderResponse] -> ShowS
$cshowList :: [CreateSAMLProviderResponse] -> ShowS
show :: CreateSAMLProviderResponse -> String
$cshow :: CreateSAMLProviderResponse -> String
showsPrec :: Int -> CreateSAMLProviderResponse -> ShowS
$cshowsPrec :: Int -> CreateSAMLProviderResponse -> ShowS
Prelude.Show, forall x.
Rep CreateSAMLProviderResponse x -> CreateSAMLProviderResponse
forall x.
CreateSAMLProviderResponse -> Rep CreateSAMLProviderResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateSAMLProviderResponse x -> CreateSAMLProviderResponse
$cfrom :: forall x.
CreateSAMLProviderResponse -> Rep CreateSAMLProviderResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateSAMLProviderResponse' 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:
--
-- 'sAMLProviderArn', 'createSAMLProviderResponse_sAMLProviderArn' - The Amazon Resource Name (ARN) of the new SAML provider resource in IAM.
--
-- 'tags', 'createSAMLProviderResponse_tags' - A list of tags that are attached to the new IAM SAML provider. The
-- returned list of tags is sorted by tag key. 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/.
--
-- 'httpStatus', 'createSAMLProviderResponse_httpStatus' - The response's http status code.
newCreateSAMLProviderResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSAMLProviderResponse
newCreateSAMLProviderResponse :: Int -> CreateSAMLProviderResponse
newCreateSAMLProviderResponse Int
pHttpStatus_ =
  CreateSAMLProviderResponse'
    { $sel:sAMLProviderArn:CreateSAMLProviderResponse' :: Maybe Text
sAMLProviderArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateSAMLProviderResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateSAMLProviderResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the new SAML provider resource in IAM.
createSAMLProviderResponse_sAMLProviderArn :: Lens.Lens' CreateSAMLProviderResponse (Prelude.Maybe Prelude.Text)
createSAMLProviderResponse_sAMLProviderArn :: Lens' CreateSAMLProviderResponse (Maybe Text)
createSAMLProviderResponse_sAMLProviderArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSAMLProviderResponse' {Maybe Text
sAMLProviderArn :: Maybe Text
$sel:sAMLProviderArn:CreateSAMLProviderResponse' :: CreateSAMLProviderResponse -> Maybe Text
sAMLProviderArn} -> Maybe Text
sAMLProviderArn) (\s :: CreateSAMLProviderResponse
s@CreateSAMLProviderResponse' {} Maybe Text
a -> CreateSAMLProviderResponse
s {$sel:sAMLProviderArn:CreateSAMLProviderResponse' :: Maybe Text
sAMLProviderArn = Maybe Text
a} :: CreateSAMLProviderResponse)

-- | A list of tags that are attached to the new IAM SAML provider. The
-- returned list of tags is sorted by tag key. 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/.
createSAMLProviderResponse_tags :: Lens.Lens' CreateSAMLProviderResponse (Prelude.Maybe [Tag])
createSAMLProviderResponse_tags :: Lens' CreateSAMLProviderResponse (Maybe [Tag])
createSAMLProviderResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSAMLProviderResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateSAMLProviderResponse' :: CreateSAMLProviderResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateSAMLProviderResponse
s@CreateSAMLProviderResponse' {} Maybe [Tag]
a -> CreateSAMLProviderResponse
s {$sel:tags:CreateSAMLProviderResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateSAMLProviderResponse) 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 response's http status code.
createSAMLProviderResponse_httpStatus :: Lens.Lens' CreateSAMLProviderResponse Prelude.Int
createSAMLProviderResponse_httpStatus :: Lens' CreateSAMLProviderResponse Int
createSAMLProviderResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSAMLProviderResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateSAMLProviderResponse' :: CreateSAMLProviderResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateSAMLProviderResponse
s@CreateSAMLProviderResponse' {} Int
a -> CreateSAMLProviderResponse
s {$sel:httpStatus:CreateSAMLProviderResponse' :: Int
httpStatus = Int
a} :: CreateSAMLProviderResponse)

instance Prelude.NFData CreateSAMLProviderResponse where
  rnf :: CreateSAMLProviderResponse -> ()
rnf CreateSAMLProviderResponse' {Int
Maybe [Tag]
Maybe Text
httpStatus :: Int
tags :: Maybe [Tag]
sAMLProviderArn :: Maybe Text
$sel:httpStatus:CreateSAMLProviderResponse' :: CreateSAMLProviderResponse -> Int
$sel:tags:CreateSAMLProviderResponse' :: CreateSAMLProviderResponse -> Maybe [Tag]
$sel:sAMLProviderArn:CreateSAMLProviderResponse' :: CreateSAMLProviderResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sAMLProviderArn
      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 Int
httpStatus