{-# 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.DirectoryService.CreateMicrosoftAD
-- 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 Microsoft AD directory in the Amazon Web Services Cloud. For
-- more information, see
-- <https://docs.aws.amazon.com/directoryservice/latest/admin-guide/directory_microsoft_ad.html Managed Microsoft AD>
-- in the /Directory Service Admin Guide/.
--
-- Before you call /CreateMicrosoftAD/, ensure that all of the required
-- permissions have been explicitly granted through a policy. For details
-- about what permissions are required to run the /CreateMicrosoftAD/
-- operation, see
-- <http://docs.aws.amazon.com/directoryservice/latest/admin-guide/UsingWithDS_IAM_ResourcePermissions.html Directory Service API Permissions: Actions, Resources, and Conditions Reference>.
module Amazonka.DirectoryService.CreateMicrosoftAD
  ( -- * Creating a Request
    CreateMicrosoftAD (..),
    newCreateMicrosoftAD,

    -- * Request Lenses
    createMicrosoftAD_description,
    createMicrosoftAD_edition,
    createMicrosoftAD_shortName,
    createMicrosoftAD_tags,
    createMicrosoftAD_name,
    createMicrosoftAD_password,
    createMicrosoftAD_vpcSettings,

    -- * Destructuring the Response
    CreateMicrosoftADResponse (..),
    newCreateMicrosoftADResponse,

    -- * Response Lenses
    createMicrosoftADResponse_directoryId,
    createMicrosoftADResponse_httpStatus,
  )
where

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

-- | Creates an Managed Microsoft AD directory.
--
-- /See:/ 'newCreateMicrosoftAD' smart constructor.
data CreateMicrosoftAD = CreateMicrosoftAD'
  { -- | A description for the directory. This label will appear on the Amazon
    -- Web Services console @Directory Details@ page after the directory is
    -- created.
    CreateMicrosoftAD -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Managed Microsoft AD is available in two editions: @Standard@ and
    -- @Enterprise@. @Enterprise@ is the default.
    CreateMicrosoftAD -> Maybe DirectoryEdition
edition :: Prelude.Maybe DirectoryEdition,
    -- | The NetBIOS name for your domain, such as @CORP@. If you don\'t specify
    -- a NetBIOS name, it will default to the first part of your directory DNS.
    -- For example, @CORP@ for the directory DNS @corp.example.com@.
    CreateMicrosoftAD -> Maybe Text
shortName :: Prelude.Maybe Prelude.Text,
    -- | The tags to be assigned to the Managed Microsoft AD directory.
    CreateMicrosoftAD -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The fully qualified domain name for the Managed Microsoft AD directory,
    -- such as @corp.example.com@. This name will resolve inside your VPC only.
    -- It does not need to be publicly resolvable.
    CreateMicrosoftAD -> Text
name :: Prelude.Text,
    -- | The password for the default administrative user named @Admin@.
    --
    -- If you need to change the password for the administrator account, you
    -- can use the ResetUserPassword API call.
    CreateMicrosoftAD -> Sensitive Text
password :: Data.Sensitive Prelude.Text,
    -- | Contains VPC information for the CreateDirectory or CreateMicrosoftAD
    -- operation.
    CreateMicrosoftAD -> DirectoryVpcSettings
vpcSettings :: DirectoryVpcSettings
  }
  deriving (CreateMicrosoftAD -> CreateMicrosoftAD -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMicrosoftAD -> CreateMicrosoftAD -> Bool
$c/= :: CreateMicrosoftAD -> CreateMicrosoftAD -> Bool
== :: CreateMicrosoftAD -> CreateMicrosoftAD -> Bool
$c== :: CreateMicrosoftAD -> CreateMicrosoftAD -> Bool
Prelude.Eq, Int -> CreateMicrosoftAD -> ShowS
[CreateMicrosoftAD] -> ShowS
CreateMicrosoftAD -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMicrosoftAD] -> ShowS
$cshowList :: [CreateMicrosoftAD] -> ShowS
show :: CreateMicrosoftAD -> String
$cshow :: CreateMicrosoftAD -> String
showsPrec :: Int -> CreateMicrosoftAD -> ShowS
$cshowsPrec :: Int -> CreateMicrosoftAD -> ShowS
Prelude.Show, forall x. Rep CreateMicrosoftAD x -> CreateMicrosoftAD
forall x. CreateMicrosoftAD -> Rep CreateMicrosoftAD x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateMicrosoftAD x -> CreateMicrosoftAD
$cfrom :: forall x. CreateMicrosoftAD -> Rep CreateMicrosoftAD x
Prelude.Generic)

-- |
-- Create a value of 'CreateMicrosoftAD' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'description', 'createMicrosoftAD_description' - A description for the directory. This label will appear on the Amazon
-- Web Services console @Directory Details@ page after the directory is
-- created.
--
-- 'edition', 'createMicrosoftAD_edition' - Managed Microsoft AD is available in two editions: @Standard@ and
-- @Enterprise@. @Enterprise@ is the default.
--
-- 'shortName', 'createMicrosoftAD_shortName' - The NetBIOS name for your domain, such as @CORP@. If you don\'t specify
-- a NetBIOS name, it will default to the first part of your directory DNS.
-- For example, @CORP@ for the directory DNS @corp.example.com@.
--
-- 'tags', 'createMicrosoftAD_tags' - The tags to be assigned to the Managed Microsoft AD directory.
--
-- 'name', 'createMicrosoftAD_name' - The fully qualified domain name for the Managed Microsoft AD directory,
-- such as @corp.example.com@. This name will resolve inside your VPC only.
-- It does not need to be publicly resolvable.
--
-- 'password', 'createMicrosoftAD_password' - The password for the default administrative user named @Admin@.
--
-- If you need to change the password for the administrator account, you
-- can use the ResetUserPassword API call.
--
-- 'vpcSettings', 'createMicrosoftAD_vpcSettings' - Contains VPC information for the CreateDirectory or CreateMicrosoftAD
-- operation.
newCreateMicrosoftAD ::
  -- | 'name'
  Prelude.Text ->
  -- | 'password'
  Prelude.Text ->
  -- | 'vpcSettings'
  DirectoryVpcSettings ->
  CreateMicrosoftAD
newCreateMicrosoftAD :: Text -> Text -> DirectoryVpcSettings -> CreateMicrosoftAD
newCreateMicrosoftAD Text
pName_ Text
pPassword_ DirectoryVpcSettings
pVpcSettings_ =
  CreateMicrosoftAD'
    { $sel:description:CreateMicrosoftAD' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:edition:CreateMicrosoftAD' :: Maybe DirectoryEdition
edition = forall a. Maybe a
Prelude.Nothing,
      $sel:shortName:CreateMicrosoftAD' :: Maybe Text
shortName = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateMicrosoftAD' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateMicrosoftAD' :: Text
name = Text
pName_,
      $sel:password:CreateMicrosoftAD' :: Sensitive Text
password = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPassword_,
      $sel:vpcSettings:CreateMicrosoftAD' :: DirectoryVpcSettings
vpcSettings = DirectoryVpcSettings
pVpcSettings_
    }

-- | A description for the directory. This label will appear on the Amazon
-- Web Services console @Directory Details@ page after the directory is
-- created.
createMicrosoftAD_description :: Lens.Lens' CreateMicrosoftAD (Prelude.Maybe Prelude.Text)
createMicrosoftAD_description :: Lens' CreateMicrosoftAD (Maybe Text)
createMicrosoftAD_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMicrosoftAD' {Maybe Text
description :: Maybe Text
$sel:description:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateMicrosoftAD
s@CreateMicrosoftAD' {} Maybe Text
a -> CreateMicrosoftAD
s {$sel:description:CreateMicrosoftAD' :: Maybe Text
description = Maybe Text
a} :: CreateMicrosoftAD)

-- | Managed Microsoft AD is available in two editions: @Standard@ and
-- @Enterprise@. @Enterprise@ is the default.
createMicrosoftAD_edition :: Lens.Lens' CreateMicrosoftAD (Prelude.Maybe DirectoryEdition)
createMicrosoftAD_edition :: Lens' CreateMicrosoftAD (Maybe DirectoryEdition)
createMicrosoftAD_edition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMicrosoftAD' {Maybe DirectoryEdition
edition :: Maybe DirectoryEdition
$sel:edition:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe DirectoryEdition
edition} -> Maybe DirectoryEdition
edition) (\s :: CreateMicrosoftAD
s@CreateMicrosoftAD' {} Maybe DirectoryEdition
a -> CreateMicrosoftAD
s {$sel:edition:CreateMicrosoftAD' :: Maybe DirectoryEdition
edition = Maybe DirectoryEdition
a} :: CreateMicrosoftAD)

-- | The NetBIOS name for your domain, such as @CORP@. If you don\'t specify
-- a NetBIOS name, it will default to the first part of your directory DNS.
-- For example, @CORP@ for the directory DNS @corp.example.com@.
createMicrosoftAD_shortName :: Lens.Lens' CreateMicrosoftAD (Prelude.Maybe Prelude.Text)
createMicrosoftAD_shortName :: Lens' CreateMicrosoftAD (Maybe Text)
createMicrosoftAD_shortName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMicrosoftAD' {Maybe Text
shortName :: Maybe Text
$sel:shortName:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe Text
shortName} -> Maybe Text
shortName) (\s :: CreateMicrosoftAD
s@CreateMicrosoftAD' {} Maybe Text
a -> CreateMicrosoftAD
s {$sel:shortName:CreateMicrosoftAD' :: Maybe Text
shortName = Maybe Text
a} :: CreateMicrosoftAD)

-- | The tags to be assigned to the Managed Microsoft AD directory.
createMicrosoftAD_tags :: Lens.Lens' CreateMicrosoftAD (Prelude.Maybe [Tag])
createMicrosoftAD_tags :: Lens' CreateMicrosoftAD (Maybe [Tag])
createMicrosoftAD_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMicrosoftAD' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateMicrosoftAD
s@CreateMicrosoftAD' {} Maybe [Tag]
a -> CreateMicrosoftAD
s {$sel:tags:CreateMicrosoftAD' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateMicrosoftAD) 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 fully qualified domain name for the Managed Microsoft AD directory,
-- such as @corp.example.com@. This name will resolve inside your VPC only.
-- It does not need to be publicly resolvable.
createMicrosoftAD_name :: Lens.Lens' CreateMicrosoftAD Prelude.Text
createMicrosoftAD_name :: Lens' CreateMicrosoftAD Text
createMicrosoftAD_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMicrosoftAD' {Text
name :: Text
$sel:name:CreateMicrosoftAD' :: CreateMicrosoftAD -> Text
name} -> Text
name) (\s :: CreateMicrosoftAD
s@CreateMicrosoftAD' {} Text
a -> CreateMicrosoftAD
s {$sel:name:CreateMicrosoftAD' :: Text
name = Text
a} :: CreateMicrosoftAD)

-- | The password for the default administrative user named @Admin@.
--
-- If you need to change the password for the administrator account, you
-- can use the ResetUserPassword API call.
createMicrosoftAD_password :: Lens.Lens' CreateMicrosoftAD Prelude.Text
createMicrosoftAD_password :: Lens' CreateMicrosoftAD Text
createMicrosoftAD_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMicrosoftAD' {Sensitive Text
password :: Sensitive Text
$sel:password:CreateMicrosoftAD' :: CreateMicrosoftAD -> Sensitive Text
password} -> Sensitive Text
password) (\s :: CreateMicrosoftAD
s@CreateMicrosoftAD' {} Sensitive Text
a -> CreateMicrosoftAD
s {$sel:password:CreateMicrosoftAD' :: Sensitive Text
password = Sensitive Text
a} :: CreateMicrosoftAD) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | Contains VPC information for the CreateDirectory or CreateMicrosoftAD
-- operation.
createMicrosoftAD_vpcSettings :: Lens.Lens' CreateMicrosoftAD DirectoryVpcSettings
createMicrosoftAD_vpcSettings :: Lens' CreateMicrosoftAD DirectoryVpcSettings
createMicrosoftAD_vpcSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMicrosoftAD' {DirectoryVpcSettings
vpcSettings :: DirectoryVpcSettings
$sel:vpcSettings:CreateMicrosoftAD' :: CreateMicrosoftAD -> DirectoryVpcSettings
vpcSettings} -> DirectoryVpcSettings
vpcSettings) (\s :: CreateMicrosoftAD
s@CreateMicrosoftAD' {} DirectoryVpcSettings
a -> CreateMicrosoftAD
s {$sel:vpcSettings:CreateMicrosoftAD' :: DirectoryVpcSettings
vpcSettings = DirectoryVpcSettings
a} :: CreateMicrosoftAD)

instance Core.AWSRequest CreateMicrosoftAD where
  type
    AWSResponse CreateMicrosoftAD =
      CreateMicrosoftADResponse
  request :: (Service -> Service)
-> CreateMicrosoftAD -> Request CreateMicrosoftAD
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 CreateMicrosoftAD
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateMicrosoftAD)))
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 -> CreateMicrosoftADResponse
CreateMicrosoftADResponse'
            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
"DirectoryId")
            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 CreateMicrosoftAD where
  hashWithSalt :: Int -> CreateMicrosoftAD -> Int
hashWithSalt Int
_salt CreateMicrosoftAD' {Maybe [Tag]
Maybe Text
Maybe DirectoryEdition
Text
Sensitive Text
DirectoryVpcSettings
vpcSettings :: DirectoryVpcSettings
password :: Sensitive Text
name :: Text
tags :: Maybe [Tag]
shortName :: Maybe Text
edition :: Maybe DirectoryEdition
description :: Maybe Text
$sel:vpcSettings:CreateMicrosoftAD' :: CreateMicrosoftAD -> DirectoryVpcSettings
$sel:password:CreateMicrosoftAD' :: CreateMicrosoftAD -> Sensitive Text
$sel:name:CreateMicrosoftAD' :: CreateMicrosoftAD -> Text
$sel:tags:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe [Tag]
$sel:shortName:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe Text
$sel:edition:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe DirectoryEdition
$sel:description:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DirectoryEdition
edition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
shortName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
password
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DirectoryVpcSettings
vpcSettings

instance Prelude.NFData CreateMicrosoftAD where
  rnf :: CreateMicrosoftAD -> ()
rnf CreateMicrosoftAD' {Maybe [Tag]
Maybe Text
Maybe DirectoryEdition
Text
Sensitive Text
DirectoryVpcSettings
vpcSettings :: DirectoryVpcSettings
password :: Sensitive Text
name :: Text
tags :: Maybe [Tag]
shortName :: Maybe Text
edition :: Maybe DirectoryEdition
description :: Maybe Text
$sel:vpcSettings:CreateMicrosoftAD' :: CreateMicrosoftAD -> DirectoryVpcSettings
$sel:password:CreateMicrosoftAD' :: CreateMicrosoftAD -> Sensitive Text
$sel:name:CreateMicrosoftAD' :: CreateMicrosoftAD -> Text
$sel:tags:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe [Tag]
$sel:shortName:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe Text
$sel:edition:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe DirectoryEdition
$sel:description:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DirectoryEdition
edition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
shortName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
password
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DirectoryVpcSettings
vpcSettings

instance Data.ToHeaders CreateMicrosoftAD where
  toHeaders :: CreateMicrosoftAD -> 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
"DirectoryService_20150416.CreateMicrosoftAD" ::
                          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 CreateMicrosoftAD where
  toJSON :: CreateMicrosoftAD -> Value
toJSON CreateMicrosoftAD' {Maybe [Tag]
Maybe Text
Maybe DirectoryEdition
Text
Sensitive Text
DirectoryVpcSettings
vpcSettings :: DirectoryVpcSettings
password :: Sensitive Text
name :: Text
tags :: Maybe [Tag]
shortName :: Maybe Text
edition :: Maybe DirectoryEdition
description :: Maybe Text
$sel:vpcSettings:CreateMicrosoftAD' :: CreateMicrosoftAD -> DirectoryVpcSettings
$sel:password:CreateMicrosoftAD' :: CreateMicrosoftAD -> Sensitive Text
$sel:name:CreateMicrosoftAD' :: CreateMicrosoftAD -> Text
$sel:tags:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe [Tag]
$sel:shortName:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe Text
$sel:edition:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe DirectoryEdition
$sel:description:CreateMicrosoftAD' :: CreateMicrosoftAD -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (Key
"Edition" 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 DirectoryEdition
edition,
            (Key
"ShortName" 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
shortName,
            (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,
            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
"Password" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
password),
            forall a. a -> Maybe a
Prelude.Just (Key
"VpcSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DirectoryVpcSettings
vpcSettings)
          ]
      )

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

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

-- | Result of a CreateMicrosoftAD request.
--
-- /See:/ 'newCreateMicrosoftADResponse' smart constructor.
data CreateMicrosoftADResponse = CreateMicrosoftADResponse'
  { -- | The identifier of the directory that was created.
    CreateMicrosoftADResponse -> Maybe Text
directoryId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateMicrosoftADResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateMicrosoftADResponse -> CreateMicrosoftADResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMicrosoftADResponse -> CreateMicrosoftADResponse -> Bool
$c/= :: CreateMicrosoftADResponse -> CreateMicrosoftADResponse -> Bool
== :: CreateMicrosoftADResponse -> CreateMicrosoftADResponse -> Bool
$c== :: CreateMicrosoftADResponse -> CreateMicrosoftADResponse -> Bool
Prelude.Eq, ReadPrec [CreateMicrosoftADResponse]
ReadPrec CreateMicrosoftADResponse
Int -> ReadS CreateMicrosoftADResponse
ReadS [CreateMicrosoftADResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateMicrosoftADResponse]
$creadListPrec :: ReadPrec [CreateMicrosoftADResponse]
readPrec :: ReadPrec CreateMicrosoftADResponse
$creadPrec :: ReadPrec CreateMicrosoftADResponse
readList :: ReadS [CreateMicrosoftADResponse]
$creadList :: ReadS [CreateMicrosoftADResponse]
readsPrec :: Int -> ReadS CreateMicrosoftADResponse
$creadsPrec :: Int -> ReadS CreateMicrosoftADResponse
Prelude.Read, Int -> CreateMicrosoftADResponse -> ShowS
[CreateMicrosoftADResponse] -> ShowS
CreateMicrosoftADResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMicrosoftADResponse] -> ShowS
$cshowList :: [CreateMicrosoftADResponse] -> ShowS
show :: CreateMicrosoftADResponse -> String
$cshow :: CreateMicrosoftADResponse -> String
showsPrec :: Int -> CreateMicrosoftADResponse -> ShowS
$cshowsPrec :: Int -> CreateMicrosoftADResponse -> ShowS
Prelude.Show, forall x.
Rep CreateMicrosoftADResponse x -> CreateMicrosoftADResponse
forall x.
CreateMicrosoftADResponse -> Rep CreateMicrosoftADResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateMicrosoftADResponse x -> CreateMicrosoftADResponse
$cfrom :: forall x.
CreateMicrosoftADResponse -> Rep CreateMicrosoftADResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateMicrosoftADResponse' 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:
--
-- 'directoryId', 'createMicrosoftADResponse_directoryId' - The identifier of the directory that was created.
--
-- 'httpStatus', 'createMicrosoftADResponse_httpStatus' - The response's http status code.
newCreateMicrosoftADResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateMicrosoftADResponse
newCreateMicrosoftADResponse :: Int -> CreateMicrosoftADResponse
newCreateMicrosoftADResponse Int
pHttpStatus_ =
  CreateMicrosoftADResponse'
    { $sel:directoryId:CreateMicrosoftADResponse' :: Maybe Text
directoryId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateMicrosoftADResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier of the directory that was created.
createMicrosoftADResponse_directoryId :: Lens.Lens' CreateMicrosoftADResponse (Prelude.Maybe Prelude.Text)
createMicrosoftADResponse_directoryId :: Lens' CreateMicrosoftADResponse (Maybe Text)
createMicrosoftADResponse_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMicrosoftADResponse' {Maybe Text
directoryId :: Maybe Text
$sel:directoryId:CreateMicrosoftADResponse' :: CreateMicrosoftADResponse -> Maybe Text
directoryId} -> Maybe Text
directoryId) (\s :: CreateMicrosoftADResponse
s@CreateMicrosoftADResponse' {} Maybe Text
a -> CreateMicrosoftADResponse
s {$sel:directoryId:CreateMicrosoftADResponse' :: Maybe Text
directoryId = Maybe Text
a} :: CreateMicrosoftADResponse)

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

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