{-# 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.FinSpaceData.CreateUser
-- 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 user in FinSpace.
module Amazonka.FinSpaceData.CreateUser
  ( -- * Creating a Request
    CreateUser (..),
    newCreateUser,

    -- * Request Lenses
    createUser_apiAccess,
    createUser_apiAccessPrincipalArn,
    createUser_clientToken,
    createUser_firstName,
    createUser_lastName,
    createUser_emailAddress,
    createUser_type,

    -- * Destructuring the Response
    CreateUserResponse (..),
    newCreateUserResponse,

    -- * Response Lenses
    createUserResponse_userId,
    createUserResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateUser' smart constructor.
data CreateUser = CreateUser'
  { -- | The option to indicate whether the user can use the
    -- @GetProgrammaticAccessCredentials@ API to obtain credentials that can
    -- then be used to access other FinSpace Data API operations.
    --
    -- -   @ENABLED@ – The user has permissions to use the APIs.
    --
    -- -   @DISABLED@ – The user does not have permissions to use any APIs.
    CreateUser -> Maybe ApiAccess
apiAccess :: Prelude.Maybe ApiAccess,
    -- | The ARN identifier of an AWS user or role that is allowed to call the
    -- @GetProgrammaticAccessCredentials@ API to obtain a credentials token for
    -- a specific FinSpace user. This must be an IAM role within your FinSpace
    -- account.
    CreateUser -> Maybe Text
apiAccessPrincipalArn :: Prelude.Maybe Prelude.Text,
    -- | A token that ensures idempotency. This token expires in 10 minutes.
    CreateUser -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The first name of the user that you want to register.
    CreateUser -> Maybe (Sensitive Text)
firstName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The last name of the user that you want to register.
    CreateUser -> Maybe (Sensitive Text)
lastName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The email address of the user that you want to register. The email
    -- address serves as a uniquer identifier for each user and cannot be
    -- changed after it\'s created.
    CreateUser -> Sensitive Text
emailAddress :: Data.Sensitive Prelude.Text,
    -- | The option to indicate the type of user. Use one of the following
    -- options to specify this parameter:
    --
    -- -   @SUPER_USER@ – A user with permission to all the functionality and
    --     data in FinSpace.
    --
    -- -   @APP_USER@ – A user with specific permissions in FinSpace. The users
    --     are assigned permissions by adding them to a permission group.
    CreateUser -> UserType
type' :: UserType
  }
  deriving (CreateUser -> CreateUser -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateUser -> CreateUser -> Bool
$c/= :: CreateUser -> CreateUser -> Bool
== :: CreateUser -> CreateUser -> Bool
$c== :: CreateUser -> CreateUser -> Bool
Prelude.Eq, Int -> CreateUser -> ShowS
[CreateUser] -> ShowS
CreateUser -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateUser] -> ShowS
$cshowList :: [CreateUser] -> ShowS
show :: CreateUser -> String
$cshow :: CreateUser -> String
showsPrec :: Int -> CreateUser -> ShowS
$cshowsPrec :: Int -> CreateUser -> ShowS
Prelude.Show, forall x. Rep CreateUser x -> CreateUser
forall x. CreateUser -> Rep CreateUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateUser x -> CreateUser
$cfrom :: forall x. CreateUser -> Rep CreateUser x
Prelude.Generic)

-- |
-- Create a value of 'CreateUser' 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:
--
-- 'apiAccess', 'createUser_apiAccess' - The option to indicate whether the user can use the
-- @GetProgrammaticAccessCredentials@ API to obtain credentials that can
-- then be used to access other FinSpace Data API operations.
--
-- -   @ENABLED@ – The user has permissions to use the APIs.
--
-- -   @DISABLED@ – The user does not have permissions to use any APIs.
--
-- 'apiAccessPrincipalArn', 'createUser_apiAccessPrincipalArn' - The ARN identifier of an AWS user or role that is allowed to call the
-- @GetProgrammaticAccessCredentials@ API to obtain a credentials token for
-- a specific FinSpace user. This must be an IAM role within your FinSpace
-- account.
--
-- 'clientToken', 'createUser_clientToken' - A token that ensures idempotency. This token expires in 10 minutes.
--
-- 'firstName', 'createUser_firstName' - The first name of the user that you want to register.
--
-- 'lastName', 'createUser_lastName' - The last name of the user that you want to register.
--
-- 'emailAddress', 'createUser_emailAddress' - The email address of the user that you want to register. The email
-- address serves as a uniquer identifier for each user and cannot be
-- changed after it\'s created.
--
-- 'type'', 'createUser_type' - The option to indicate the type of user. Use one of the following
-- options to specify this parameter:
--
-- -   @SUPER_USER@ – A user with permission to all the functionality and
--     data in FinSpace.
--
-- -   @APP_USER@ – A user with specific permissions in FinSpace. The users
--     are assigned permissions by adding them to a permission group.
newCreateUser ::
  -- | 'emailAddress'
  Prelude.Text ->
  -- | 'type''
  UserType ->
  CreateUser
newCreateUser :: Text -> UserType -> CreateUser
newCreateUser Text
pEmailAddress_ UserType
pType_ =
  CreateUser'
    { $sel:apiAccess:CreateUser' :: Maybe ApiAccess
apiAccess = forall a. Maybe a
Prelude.Nothing,
      $sel:apiAccessPrincipalArn:CreateUser' :: Maybe Text
apiAccessPrincipalArn = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:CreateUser' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:firstName:CreateUser' :: Maybe (Sensitive Text)
firstName = forall a. Maybe a
Prelude.Nothing,
      $sel:lastName:CreateUser' :: Maybe (Sensitive Text)
lastName = forall a. Maybe a
Prelude.Nothing,
      $sel:emailAddress:CreateUser' :: Sensitive Text
emailAddress = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pEmailAddress_,
      $sel:type':CreateUser' :: UserType
type' = UserType
pType_
    }

-- | The option to indicate whether the user can use the
-- @GetProgrammaticAccessCredentials@ API to obtain credentials that can
-- then be used to access other FinSpace Data API operations.
--
-- -   @ENABLED@ – The user has permissions to use the APIs.
--
-- -   @DISABLED@ – The user does not have permissions to use any APIs.
createUser_apiAccess :: Lens.Lens' CreateUser (Prelude.Maybe ApiAccess)
createUser_apiAccess :: Lens' CreateUser (Maybe ApiAccess)
createUser_apiAccess = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUser' {Maybe ApiAccess
apiAccess :: Maybe ApiAccess
$sel:apiAccess:CreateUser' :: CreateUser -> Maybe ApiAccess
apiAccess} -> Maybe ApiAccess
apiAccess) (\s :: CreateUser
s@CreateUser' {} Maybe ApiAccess
a -> CreateUser
s {$sel:apiAccess:CreateUser' :: Maybe ApiAccess
apiAccess = Maybe ApiAccess
a} :: CreateUser)

-- | The ARN identifier of an AWS user or role that is allowed to call the
-- @GetProgrammaticAccessCredentials@ API to obtain a credentials token for
-- a specific FinSpace user. This must be an IAM role within your FinSpace
-- account.
createUser_apiAccessPrincipalArn :: Lens.Lens' CreateUser (Prelude.Maybe Prelude.Text)
createUser_apiAccessPrincipalArn :: Lens' CreateUser (Maybe Text)
createUser_apiAccessPrincipalArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUser' {Maybe Text
apiAccessPrincipalArn :: Maybe Text
$sel:apiAccessPrincipalArn:CreateUser' :: CreateUser -> Maybe Text
apiAccessPrincipalArn} -> Maybe Text
apiAccessPrincipalArn) (\s :: CreateUser
s@CreateUser' {} Maybe Text
a -> CreateUser
s {$sel:apiAccessPrincipalArn:CreateUser' :: Maybe Text
apiAccessPrincipalArn = Maybe Text
a} :: CreateUser)

-- | A token that ensures idempotency. This token expires in 10 minutes.
createUser_clientToken :: Lens.Lens' CreateUser (Prelude.Maybe Prelude.Text)
createUser_clientToken :: Lens' CreateUser (Maybe Text)
createUser_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUser' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateUser' :: CreateUser -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateUser
s@CreateUser' {} Maybe Text
a -> CreateUser
s {$sel:clientToken:CreateUser' :: Maybe Text
clientToken = Maybe Text
a} :: CreateUser)

-- | The first name of the user that you want to register.
createUser_firstName :: Lens.Lens' CreateUser (Prelude.Maybe Prelude.Text)
createUser_firstName :: Lens' CreateUser (Maybe Text)
createUser_firstName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUser' {Maybe (Sensitive Text)
firstName :: Maybe (Sensitive Text)
$sel:firstName:CreateUser' :: CreateUser -> Maybe (Sensitive Text)
firstName} -> Maybe (Sensitive Text)
firstName) (\s :: CreateUser
s@CreateUser' {} Maybe (Sensitive Text)
a -> CreateUser
s {$sel:firstName:CreateUser' :: Maybe (Sensitive Text)
firstName = Maybe (Sensitive Text)
a} :: CreateUser) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The last name of the user that you want to register.
createUser_lastName :: Lens.Lens' CreateUser (Prelude.Maybe Prelude.Text)
createUser_lastName :: Lens' CreateUser (Maybe Text)
createUser_lastName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUser' {Maybe (Sensitive Text)
lastName :: Maybe (Sensitive Text)
$sel:lastName:CreateUser' :: CreateUser -> Maybe (Sensitive Text)
lastName} -> Maybe (Sensitive Text)
lastName) (\s :: CreateUser
s@CreateUser' {} Maybe (Sensitive Text)
a -> CreateUser
s {$sel:lastName:CreateUser' :: Maybe (Sensitive Text)
lastName = Maybe (Sensitive Text)
a} :: CreateUser) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The email address of the user that you want to register. The email
-- address serves as a uniquer identifier for each user and cannot be
-- changed after it\'s created.
createUser_emailAddress :: Lens.Lens' CreateUser Prelude.Text
createUser_emailAddress :: Lens' CreateUser Text
createUser_emailAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUser' {Sensitive Text
emailAddress :: Sensitive Text
$sel:emailAddress:CreateUser' :: CreateUser -> Sensitive Text
emailAddress} -> Sensitive Text
emailAddress) (\s :: CreateUser
s@CreateUser' {} Sensitive Text
a -> CreateUser
s {$sel:emailAddress:CreateUser' :: Sensitive Text
emailAddress = Sensitive Text
a} :: CreateUser) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The option to indicate the type of user. Use one of the following
-- options to specify this parameter:
--
-- -   @SUPER_USER@ – A user with permission to all the functionality and
--     data in FinSpace.
--
-- -   @APP_USER@ – A user with specific permissions in FinSpace. The users
--     are assigned permissions by adding them to a permission group.
createUser_type :: Lens.Lens' CreateUser UserType
createUser_type :: Lens' CreateUser UserType
createUser_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUser' {UserType
type' :: UserType
$sel:type':CreateUser' :: CreateUser -> UserType
type'} -> UserType
type') (\s :: CreateUser
s@CreateUser' {} UserType
a -> CreateUser
s {$sel:type':CreateUser' :: UserType
type' = UserType
a} :: CreateUser)

instance Core.AWSRequest CreateUser where
  type AWSResponse CreateUser = CreateUserResponse
  request :: (Service -> Service) -> CreateUser -> Request CreateUser
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 CreateUser
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateUser)))
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 -> CreateUserResponse
CreateUserResponse'
            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
"userId")
            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 CreateUser where
  hashWithSalt :: Int -> CreateUser -> Int
hashWithSalt Int
_salt CreateUser' {Maybe Text
Maybe (Sensitive Text)
Maybe ApiAccess
Sensitive Text
UserType
type' :: UserType
emailAddress :: Sensitive Text
lastName :: Maybe (Sensitive Text)
firstName :: Maybe (Sensitive Text)
clientToken :: Maybe Text
apiAccessPrincipalArn :: Maybe Text
apiAccess :: Maybe ApiAccess
$sel:type':CreateUser' :: CreateUser -> UserType
$sel:emailAddress:CreateUser' :: CreateUser -> Sensitive Text
$sel:lastName:CreateUser' :: CreateUser -> Maybe (Sensitive Text)
$sel:firstName:CreateUser' :: CreateUser -> Maybe (Sensitive Text)
$sel:clientToken:CreateUser' :: CreateUser -> Maybe Text
$sel:apiAccessPrincipalArn:CreateUser' :: CreateUser -> Maybe Text
$sel:apiAccess:CreateUser' :: CreateUser -> Maybe ApiAccess
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ApiAccess
apiAccess
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
apiAccessPrincipalArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
firstName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
lastName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
emailAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UserType
type'

instance Prelude.NFData CreateUser where
  rnf :: CreateUser -> ()
rnf CreateUser' {Maybe Text
Maybe (Sensitive Text)
Maybe ApiAccess
Sensitive Text
UserType
type' :: UserType
emailAddress :: Sensitive Text
lastName :: Maybe (Sensitive Text)
firstName :: Maybe (Sensitive Text)
clientToken :: Maybe Text
apiAccessPrincipalArn :: Maybe Text
apiAccess :: Maybe ApiAccess
$sel:type':CreateUser' :: CreateUser -> UserType
$sel:emailAddress:CreateUser' :: CreateUser -> Sensitive Text
$sel:lastName:CreateUser' :: CreateUser -> Maybe (Sensitive Text)
$sel:firstName:CreateUser' :: CreateUser -> Maybe (Sensitive Text)
$sel:clientToken:CreateUser' :: CreateUser -> Maybe Text
$sel:apiAccessPrincipalArn:CreateUser' :: CreateUser -> Maybe Text
$sel:apiAccess:CreateUser' :: CreateUser -> Maybe ApiAccess
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ApiAccess
apiAccess
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
apiAccessPrincipalArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
firstName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
lastName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
emailAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UserType
type'

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

instance Data.ToJSON CreateUser where
  toJSON :: CreateUser -> Value
toJSON CreateUser' {Maybe Text
Maybe (Sensitive Text)
Maybe ApiAccess
Sensitive Text
UserType
type' :: UserType
emailAddress :: Sensitive Text
lastName :: Maybe (Sensitive Text)
firstName :: Maybe (Sensitive Text)
clientToken :: Maybe Text
apiAccessPrincipalArn :: Maybe Text
apiAccess :: Maybe ApiAccess
$sel:type':CreateUser' :: CreateUser -> UserType
$sel:emailAddress:CreateUser' :: CreateUser -> Sensitive Text
$sel:lastName:CreateUser' :: CreateUser -> Maybe (Sensitive Text)
$sel:firstName:CreateUser' :: CreateUser -> Maybe (Sensitive Text)
$sel:clientToken:CreateUser' :: CreateUser -> Maybe Text
$sel:apiAccessPrincipalArn:CreateUser' :: CreateUser -> Maybe Text
$sel:apiAccess:CreateUser' :: CreateUser -> Maybe ApiAccess
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ApiAccess" 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 ApiAccess
apiAccess,
            (Key
"apiAccessPrincipalArn" 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
apiAccessPrincipalArn,
            (Key
"clientToken" 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
clientToken,
            (Key
"firstName" 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 (Sensitive Text)
firstName,
            (Key
"lastName" 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 (Sensitive Text)
lastName,
            forall a. a -> Maybe a
Prelude.Just (Key
"emailAddress" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
emailAddress),
            forall a. a -> Maybe a
Prelude.Just (Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= UserType
type')
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateUserResponse' 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:
--
-- 'userId', 'createUserResponse_userId' - The unique identifier for the user.
--
-- 'httpStatus', 'createUserResponse_httpStatus' - The response's http status code.
newCreateUserResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateUserResponse
newCreateUserResponse :: Int -> CreateUserResponse
newCreateUserResponse Int
pHttpStatus_ =
  CreateUserResponse'
    { $sel:userId:CreateUserResponse' :: Maybe Text
userId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateUserResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The unique identifier for the user.
createUserResponse_userId :: Lens.Lens' CreateUserResponse (Prelude.Maybe Prelude.Text)
createUserResponse_userId :: Lens' CreateUserResponse (Maybe Text)
createUserResponse_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUserResponse' {Maybe Text
userId :: Maybe Text
$sel:userId:CreateUserResponse' :: CreateUserResponse -> Maybe Text
userId} -> Maybe Text
userId) (\s :: CreateUserResponse
s@CreateUserResponse' {} Maybe Text
a -> CreateUserResponse
s {$sel:userId:CreateUserResponse' :: Maybe Text
userId = Maybe Text
a} :: CreateUserResponse)

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

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