{-# 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.SageMaker.CreateUserProfile
-- 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 user profile. A user profile represents a single user within a
-- domain, and is the main way to reference a \"person\" for the purposes
-- of sharing, reporting, and other user-oriented features. This entity is
-- created when a user onboards to Amazon SageMaker Studio. If an
-- administrator invites a person by email or imports them from IAM
-- Identity Center, a user profile is automatically created. A user profile
-- is the primary holder of settings for an individual user and has a
-- reference to the user\'s private Amazon Elastic File System (EFS) home
-- directory.
module Amazonka.SageMaker.CreateUserProfile
  ( -- * Creating a Request
    CreateUserProfile (..),
    newCreateUserProfile,

    -- * Request Lenses
    createUserProfile_singleSignOnUserIdentifier,
    createUserProfile_singleSignOnUserValue,
    createUserProfile_tags,
    createUserProfile_userSettings,
    createUserProfile_domainId,
    createUserProfile_userProfileName,

    -- * Destructuring the Response
    CreateUserProfileResponse (..),
    newCreateUserProfileResponse,

    -- * Response Lenses
    createUserProfileResponse_userProfileArn,
    createUserProfileResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SageMaker.Types

-- | /See:/ 'newCreateUserProfile' smart constructor.
data CreateUserProfile = CreateUserProfile'
  { -- | A specifier for the type of value specified in SingleSignOnUserValue.
    -- Currently, the only supported value is \"UserName\". If the Domain\'s
    -- AuthMode is IAM Identity Center, this field is required. If the
    -- Domain\'s AuthMode is not IAM Identity Center, this field cannot be
    -- specified.
    CreateUserProfile -> Maybe Text
singleSignOnUserIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The username of the associated Amazon Web Services Single Sign-On User
    -- for this UserProfile. If the Domain\'s AuthMode is IAM Identity Center,
    -- this field is required, and must match a valid username of a user in
    -- your directory. If the Domain\'s AuthMode is not IAM Identity Center,
    -- this field cannot be specified.
    CreateUserProfile -> Maybe Text
singleSignOnUserValue :: Prelude.Maybe Prelude.Text,
    -- | Each tag consists of a key and an optional value. Tag keys must be
    -- unique per resource.
    --
    -- Tags that you specify for the User Profile are also added to all Apps
    -- that the User Profile launches.
    CreateUserProfile -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A collection of settings.
    CreateUserProfile -> Maybe UserSettings
userSettings :: Prelude.Maybe UserSettings,
    -- | The ID of the associated Domain.
    CreateUserProfile -> Text
domainId :: Prelude.Text,
    -- | A name for the UserProfile. This value is not case sensitive.
    CreateUserProfile -> Text
userProfileName :: Prelude.Text
  }
  deriving (CreateUserProfile -> CreateUserProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateUserProfile -> CreateUserProfile -> Bool
$c/= :: CreateUserProfile -> CreateUserProfile -> Bool
== :: CreateUserProfile -> CreateUserProfile -> Bool
$c== :: CreateUserProfile -> CreateUserProfile -> Bool
Prelude.Eq, ReadPrec [CreateUserProfile]
ReadPrec CreateUserProfile
Int -> ReadS CreateUserProfile
ReadS [CreateUserProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateUserProfile]
$creadListPrec :: ReadPrec [CreateUserProfile]
readPrec :: ReadPrec CreateUserProfile
$creadPrec :: ReadPrec CreateUserProfile
readList :: ReadS [CreateUserProfile]
$creadList :: ReadS [CreateUserProfile]
readsPrec :: Int -> ReadS CreateUserProfile
$creadsPrec :: Int -> ReadS CreateUserProfile
Prelude.Read, Int -> CreateUserProfile -> ShowS
[CreateUserProfile] -> ShowS
CreateUserProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateUserProfile] -> ShowS
$cshowList :: [CreateUserProfile] -> ShowS
show :: CreateUserProfile -> String
$cshow :: CreateUserProfile -> String
showsPrec :: Int -> CreateUserProfile -> ShowS
$cshowsPrec :: Int -> CreateUserProfile -> ShowS
Prelude.Show, forall x. Rep CreateUserProfile x -> CreateUserProfile
forall x. CreateUserProfile -> Rep CreateUserProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateUserProfile x -> CreateUserProfile
$cfrom :: forall x. CreateUserProfile -> Rep CreateUserProfile x
Prelude.Generic)

-- |
-- Create a value of 'CreateUserProfile' 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:
--
-- 'singleSignOnUserIdentifier', 'createUserProfile_singleSignOnUserIdentifier' - A specifier for the type of value specified in SingleSignOnUserValue.
-- Currently, the only supported value is \"UserName\". If the Domain\'s
-- AuthMode is IAM Identity Center, this field is required. If the
-- Domain\'s AuthMode is not IAM Identity Center, this field cannot be
-- specified.
--
-- 'singleSignOnUserValue', 'createUserProfile_singleSignOnUserValue' - The username of the associated Amazon Web Services Single Sign-On User
-- for this UserProfile. If the Domain\'s AuthMode is IAM Identity Center,
-- this field is required, and must match a valid username of a user in
-- your directory. If the Domain\'s AuthMode is not IAM Identity Center,
-- this field cannot be specified.
--
-- 'tags', 'createUserProfile_tags' - Each tag consists of a key and an optional value. Tag keys must be
-- unique per resource.
--
-- Tags that you specify for the User Profile are also added to all Apps
-- that the User Profile launches.
--
-- 'userSettings', 'createUserProfile_userSettings' - A collection of settings.
--
-- 'domainId', 'createUserProfile_domainId' - The ID of the associated Domain.
--
-- 'userProfileName', 'createUserProfile_userProfileName' - A name for the UserProfile. This value is not case sensitive.
newCreateUserProfile ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'userProfileName'
  Prelude.Text ->
  CreateUserProfile
newCreateUserProfile :: Text -> Text -> CreateUserProfile
newCreateUserProfile Text
pDomainId_ Text
pUserProfileName_ =
  CreateUserProfile'
    { $sel:singleSignOnUserIdentifier:CreateUserProfile' :: Maybe Text
singleSignOnUserIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:singleSignOnUserValue:CreateUserProfile' :: Maybe Text
singleSignOnUserValue = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateUserProfile' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:userSettings:CreateUserProfile' :: Maybe UserSettings
userSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:domainId:CreateUserProfile' :: Text
domainId = Text
pDomainId_,
      $sel:userProfileName:CreateUserProfile' :: Text
userProfileName = Text
pUserProfileName_
    }

-- | A specifier for the type of value specified in SingleSignOnUserValue.
-- Currently, the only supported value is \"UserName\". If the Domain\'s
-- AuthMode is IAM Identity Center, this field is required. If the
-- Domain\'s AuthMode is not IAM Identity Center, this field cannot be
-- specified.
createUserProfile_singleSignOnUserIdentifier :: Lens.Lens' CreateUserProfile (Prelude.Maybe Prelude.Text)
createUserProfile_singleSignOnUserIdentifier :: Lens' CreateUserProfile (Maybe Text)
createUserProfile_singleSignOnUserIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUserProfile' {Maybe Text
singleSignOnUserIdentifier :: Maybe Text
$sel:singleSignOnUserIdentifier:CreateUserProfile' :: CreateUserProfile -> Maybe Text
singleSignOnUserIdentifier} -> Maybe Text
singleSignOnUserIdentifier) (\s :: CreateUserProfile
s@CreateUserProfile' {} Maybe Text
a -> CreateUserProfile
s {$sel:singleSignOnUserIdentifier:CreateUserProfile' :: Maybe Text
singleSignOnUserIdentifier = Maybe Text
a} :: CreateUserProfile)

-- | The username of the associated Amazon Web Services Single Sign-On User
-- for this UserProfile. If the Domain\'s AuthMode is IAM Identity Center,
-- this field is required, and must match a valid username of a user in
-- your directory. If the Domain\'s AuthMode is not IAM Identity Center,
-- this field cannot be specified.
createUserProfile_singleSignOnUserValue :: Lens.Lens' CreateUserProfile (Prelude.Maybe Prelude.Text)
createUserProfile_singleSignOnUserValue :: Lens' CreateUserProfile (Maybe Text)
createUserProfile_singleSignOnUserValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUserProfile' {Maybe Text
singleSignOnUserValue :: Maybe Text
$sel:singleSignOnUserValue:CreateUserProfile' :: CreateUserProfile -> Maybe Text
singleSignOnUserValue} -> Maybe Text
singleSignOnUserValue) (\s :: CreateUserProfile
s@CreateUserProfile' {} Maybe Text
a -> CreateUserProfile
s {$sel:singleSignOnUserValue:CreateUserProfile' :: Maybe Text
singleSignOnUserValue = Maybe Text
a} :: CreateUserProfile)

-- | Each tag consists of a key and an optional value. Tag keys must be
-- unique per resource.
--
-- Tags that you specify for the User Profile are also added to all Apps
-- that the User Profile launches.
createUserProfile_tags :: Lens.Lens' CreateUserProfile (Prelude.Maybe [Tag])
createUserProfile_tags :: Lens' CreateUserProfile (Maybe [Tag])
createUserProfile_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUserProfile' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateUserProfile' :: CreateUserProfile -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateUserProfile
s@CreateUserProfile' {} Maybe [Tag]
a -> CreateUserProfile
s {$sel:tags:CreateUserProfile' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateUserProfile) 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

-- | A collection of settings.
createUserProfile_userSettings :: Lens.Lens' CreateUserProfile (Prelude.Maybe UserSettings)
createUserProfile_userSettings :: Lens' CreateUserProfile (Maybe UserSettings)
createUserProfile_userSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUserProfile' {Maybe UserSettings
userSettings :: Maybe UserSettings
$sel:userSettings:CreateUserProfile' :: CreateUserProfile -> Maybe UserSettings
userSettings} -> Maybe UserSettings
userSettings) (\s :: CreateUserProfile
s@CreateUserProfile' {} Maybe UserSettings
a -> CreateUserProfile
s {$sel:userSettings:CreateUserProfile' :: Maybe UserSettings
userSettings = Maybe UserSettings
a} :: CreateUserProfile)

-- | The ID of the associated Domain.
createUserProfile_domainId :: Lens.Lens' CreateUserProfile Prelude.Text
createUserProfile_domainId :: Lens' CreateUserProfile Text
createUserProfile_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUserProfile' {Text
domainId :: Text
$sel:domainId:CreateUserProfile' :: CreateUserProfile -> Text
domainId} -> Text
domainId) (\s :: CreateUserProfile
s@CreateUserProfile' {} Text
a -> CreateUserProfile
s {$sel:domainId:CreateUserProfile' :: Text
domainId = Text
a} :: CreateUserProfile)

-- | A name for the UserProfile. This value is not case sensitive.
createUserProfile_userProfileName :: Lens.Lens' CreateUserProfile Prelude.Text
createUserProfile_userProfileName :: Lens' CreateUserProfile Text
createUserProfile_userProfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUserProfile' {Text
userProfileName :: Text
$sel:userProfileName:CreateUserProfile' :: CreateUserProfile -> Text
userProfileName} -> Text
userProfileName) (\s :: CreateUserProfile
s@CreateUserProfile' {} Text
a -> CreateUserProfile
s {$sel:userProfileName:CreateUserProfile' :: Text
userProfileName = Text
a} :: CreateUserProfile)

instance Core.AWSRequest CreateUserProfile where
  type
    AWSResponse CreateUserProfile =
      CreateUserProfileResponse
  request :: (Service -> Service)
-> CreateUserProfile -> Request CreateUserProfile
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateUserProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateUserProfile)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> CreateUserProfileResponse
CreateUserProfileResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"UserProfileArn")
            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 CreateUserProfile where
  hashWithSalt :: Int -> CreateUserProfile -> Int
hashWithSalt Int
_salt CreateUserProfile' {Maybe [Tag]
Maybe Text
Maybe UserSettings
Text
userProfileName :: Text
domainId :: Text
userSettings :: Maybe UserSettings
tags :: Maybe [Tag]
singleSignOnUserValue :: Maybe Text
singleSignOnUserIdentifier :: Maybe Text
$sel:userProfileName:CreateUserProfile' :: CreateUserProfile -> Text
$sel:domainId:CreateUserProfile' :: CreateUserProfile -> Text
$sel:userSettings:CreateUserProfile' :: CreateUserProfile -> Maybe UserSettings
$sel:tags:CreateUserProfile' :: CreateUserProfile -> Maybe [Tag]
$sel:singleSignOnUserValue:CreateUserProfile' :: CreateUserProfile -> Maybe Text
$sel:singleSignOnUserIdentifier:CreateUserProfile' :: CreateUserProfile -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
singleSignOnUserIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
singleSignOnUserValue
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UserSettings
userSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userProfileName

instance Prelude.NFData CreateUserProfile where
  rnf :: CreateUserProfile -> ()
rnf CreateUserProfile' {Maybe [Tag]
Maybe Text
Maybe UserSettings
Text
userProfileName :: Text
domainId :: Text
userSettings :: Maybe UserSettings
tags :: Maybe [Tag]
singleSignOnUserValue :: Maybe Text
singleSignOnUserIdentifier :: Maybe Text
$sel:userProfileName:CreateUserProfile' :: CreateUserProfile -> Text
$sel:domainId:CreateUserProfile' :: CreateUserProfile -> Text
$sel:userSettings:CreateUserProfile' :: CreateUserProfile -> Maybe UserSettings
$sel:tags:CreateUserProfile' :: CreateUserProfile -> Maybe [Tag]
$sel:singleSignOnUserValue:CreateUserProfile' :: CreateUserProfile -> Maybe Text
$sel:singleSignOnUserIdentifier:CreateUserProfile' :: CreateUserProfile -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
singleSignOnUserIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
singleSignOnUserValue
      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 Maybe UserSettings
userSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userProfileName

instance Data.ToHeaders CreateUserProfile where
  toHeaders :: CreateUserProfile -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"SageMaker.CreateUserProfile" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateUserProfile where
  toJSON :: CreateUserProfile -> Value
toJSON CreateUserProfile' {Maybe [Tag]
Maybe Text
Maybe UserSettings
Text
userProfileName :: Text
domainId :: Text
userSettings :: Maybe UserSettings
tags :: Maybe [Tag]
singleSignOnUserValue :: Maybe Text
singleSignOnUserIdentifier :: Maybe Text
$sel:userProfileName:CreateUserProfile' :: CreateUserProfile -> Text
$sel:domainId:CreateUserProfile' :: CreateUserProfile -> Text
$sel:userSettings:CreateUserProfile' :: CreateUserProfile -> Maybe UserSettings
$sel:tags:CreateUserProfile' :: CreateUserProfile -> Maybe [Tag]
$sel:singleSignOnUserValue:CreateUserProfile' :: CreateUserProfile -> Maybe Text
$sel:singleSignOnUserIdentifier:CreateUserProfile' :: CreateUserProfile -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"SingleSignOnUserIdentifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
singleSignOnUserIdentifier,
            (Key
"SingleSignOnUserValue" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
singleSignOnUserValue,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            (Key
"UserSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe UserSettings
userSettings,
            forall a. a -> Maybe a
Prelude.Just (Key
"DomainId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"UserProfileName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userProfileName)
          ]
      )

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

instance Data.ToQuery CreateUserProfile where
  toQuery :: CreateUserProfile -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

-- |
-- Create a value of 'CreateUserProfileResponse' 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:
--
-- 'userProfileArn', 'createUserProfileResponse_userProfileArn' - The user profile Amazon Resource Name (ARN).
--
-- 'httpStatus', 'createUserProfileResponse_httpStatus' - The response's http status code.
newCreateUserProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateUserProfileResponse
newCreateUserProfileResponse :: Int -> CreateUserProfileResponse
newCreateUserProfileResponse Int
pHttpStatus_ =
  CreateUserProfileResponse'
    { $sel:userProfileArn:CreateUserProfileResponse' :: Maybe Text
userProfileArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateUserProfileResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The user profile Amazon Resource Name (ARN).
createUserProfileResponse_userProfileArn :: Lens.Lens' CreateUserProfileResponse (Prelude.Maybe Prelude.Text)
createUserProfileResponse_userProfileArn :: Lens' CreateUserProfileResponse (Maybe Text)
createUserProfileResponse_userProfileArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUserProfileResponse' {Maybe Text
userProfileArn :: Maybe Text
$sel:userProfileArn:CreateUserProfileResponse' :: CreateUserProfileResponse -> Maybe Text
userProfileArn} -> Maybe Text
userProfileArn) (\s :: CreateUserProfileResponse
s@CreateUserProfileResponse' {} Maybe Text
a -> CreateUserProfileResponse
s {$sel:userProfileArn:CreateUserProfileResponse' :: Maybe Text
userProfileArn = Maybe Text
a} :: CreateUserProfileResponse)

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

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