{-# 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.WorkMail.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 user who can be used in WorkMail by calling the
-- RegisterToWorkMail operation.
module Amazonka.WorkMail.CreateUser
  ( -- * Creating a Request
    CreateUser (..),
    newCreateUser,

    -- * Request Lenses
    createUser_organizationId,
    createUser_name,
    createUser_displayName,
    createUser_password,

    -- * 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 qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.WorkMail.Types

-- | /See:/ 'newCreateUser' smart constructor.
data CreateUser = CreateUser'
  { -- | The identifier of the organization for which the user is created.
    CreateUser -> Text
organizationId :: Prelude.Text,
    -- | The name for the new user. WorkMail directory user names have a maximum
    -- length of 64. All others have a maximum length of 20.
    CreateUser -> Text
name :: Prelude.Text,
    -- | The display name for the new user.
    CreateUser -> Text
displayName :: Prelude.Text,
    -- | The password for the new user.
    CreateUser -> Sensitive Text
password :: Data.Sensitive Prelude.Text
  }
  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:
--
-- 'organizationId', 'createUser_organizationId' - The identifier of the organization for which the user is created.
--
-- 'name', 'createUser_name' - The name for the new user. WorkMail directory user names have a maximum
-- length of 64. All others have a maximum length of 20.
--
-- 'displayName', 'createUser_displayName' - The display name for the new user.
--
-- 'password', 'createUser_password' - The password for the new user.
newCreateUser ::
  -- | 'organizationId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'displayName'
  Prelude.Text ->
  -- | 'password'
  Prelude.Text ->
  CreateUser
newCreateUser :: Text -> Text -> Text -> Text -> CreateUser
newCreateUser
  Text
pOrganizationId_
  Text
pName_
  Text
pDisplayName_
  Text
pPassword_ =
    CreateUser'
      { $sel:organizationId:CreateUser' :: Text
organizationId = Text
pOrganizationId_,
        $sel:name:CreateUser' :: Text
name = Text
pName_,
        $sel:displayName:CreateUser' :: Text
displayName = Text
pDisplayName_,
        $sel:password:CreateUser' :: Sensitive Text
password = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPassword_
      }

-- | The identifier of the organization for which the user is created.
createUser_organizationId :: Lens.Lens' CreateUser Prelude.Text
createUser_organizationId :: Lens' CreateUser Text
createUser_organizationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUser' {Text
organizationId :: Text
$sel:organizationId:CreateUser' :: CreateUser -> Text
organizationId} -> Text
organizationId) (\s :: CreateUser
s@CreateUser' {} Text
a -> CreateUser
s {$sel:organizationId:CreateUser' :: Text
organizationId = Text
a} :: CreateUser)

-- | The name for the new user. WorkMail directory user names have a maximum
-- length of 64. All others have a maximum length of 20.
createUser_name :: Lens.Lens' CreateUser Prelude.Text
createUser_name :: Lens' CreateUser Text
createUser_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUser' {Text
name :: Text
$sel:name:CreateUser' :: CreateUser -> Text
name} -> Text
name) (\s :: CreateUser
s@CreateUser' {} Text
a -> CreateUser
s {$sel:name:CreateUser' :: Text
name = Text
a} :: CreateUser)

-- | The display name for the new user.
createUser_displayName :: Lens.Lens' CreateUser Prelude.Text
createUser_displayName :: Lens' CreateUser Text
createUser_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUser' {Text
displayName :: Text
$sel:displayName:CreateUser' :: CreateUser -> Text
displayName} -> Text
displayName) (\s :: CreateUser
s@CreateUser' {} Text
a -> CreateUser
s {$sel:displayName:CreateUser' :: Text
displayName = Text
a} :: CreateUser)

-- | The password for the new user.
createUser_password :: Lens.Lens' CreateUser Prelude.Text
createUser_password :: Lens' CreateUser Text
createUser_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUser' {Sensitive Text
password :: Sensitive Text
$sel:password:CreateUser' :: CreateUser -> Sensitive Text
password} -> Sensitive Text
password) (\s :: CreateUser
s@CreateUser' {} Sensitive Text
a -> CreateUser
s {$sel:password:CreateUser' :: Sensitive Text
password = Sensitive Text
a} :: CreateUser) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

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' {Text
Sensitive Text
password :: Sensitive Text
displayName :: Text
name :: Text
organizationId :: Text
$sel:password:CreateUser' :: CreateUser -> Sensitive Text
$sel:displayName:CreateUser' :: CreateUser -> Text
$sel:name:CreateUser' :: CreateUser -> Text
$sel:organizationId:CreateUser' :: CreateUser -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
organizationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
displayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
password

instance Prelude.NFData CreateUser where
  rnf :: CreateUser -> ()
rnf CreateUser' {Text
Sensitive Text
password :: Sensitive Text
displayName :: Text
name :: Text
organizationId :: Text
$sel:password:CreateUser' :: CreateUser -> Sensitive Text
$sel:displayName:CreateUser' :: CreateUser -> Text
$sel:name:CreateUser' :: CreateUser -> Text
$sel:organizationId:CreateUser' :: CreateUser -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
organizationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
displayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
password

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
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"WorkMailService.CreateUser" :: 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 CreateUser where
  toJSON :: CreateUser -> Value
toJSON CreateUser' {Text
Sensitive Text
password :: Sensitive Text
displayName :: Text
name :: Text
organizationId :: Text
$sel:password:CreateUser' :: CreateUser -> Sensitive Text
$sel:displayName:CreateUser' :: CreateUser -> Text
$sel:name:CreateUser' :: CreateUser -> Text
$sel:organizationId:CreateUser' :: CreateUser -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"OrganizationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
organizationId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"DisplayName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
displayName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Password" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
password)
          ]
      )

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

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 identifier for the new 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 identifier for the new 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 identifier for the new 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