{-# 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.OpenSearch.CreateDomain
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an Amazon OpenSearch Service domain. For more information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/createupdatedomains.html Creating and managing Amazon OpenSearch Service domains>.
module Amazonka.OpenSearch.CreateDomain
  ( -- * Creating a Request
    CreateDomain (..),
    newCreateDomain,

    -- * Request Lenses
    createDomain_accessPolicies,
    createDomain_advancedOptions,
    createDomain_advancedSecurityOptions,
    createDomain_autoTuneOptions,
    createDomain_clusterConfig,
    createDomain_cognitoOptions,
    createDomain_domainEndpointOptions,
    createDomain_eBSOptions,
    createDomain_encryptionAtRestOptions,
    createDomain_engineVersion,
    createDomain_logPublishingOptions,
    createDomain_nodeToNodeEncryptionOptions,
    createDomain_snapshotOptions,
    createDomain_tagList,
    createDomain_vPCOptions,
    createDomain_domainName,

    -- * Destructuring the Response
    CreateDomainResponse (..),
    newCreateDomainResponse,

    -- * Response Lenses
    createDomainResponse_domainStatus,
    createDomainResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateDomain' smart constructor.
data CreateDomain = CreateDomain'
  { -- | Identity and Access Management (IAM) policy document specifying the
    -- access policies for the new domain.
    CreateDomain -> Maybe Text
accessPolicies :: Prelude.Maybe Prelude.Text,
    -- | Key-value pairs to specify advanced configuration options. The following
    -- key-value pairs are supported:
    --
    -- -   @\"rest.action.multi.allow_explicit_index\": \"true\" | \"false\"@ -
    --     Note the use of a string rather than a boolean. Specifies whether
    --     explicit references to indexes are allowed inside the body of HTTP
    --     requests. If you want to configure access policies for domain
    --     sub-resources, such as specific indexes and domain APIs, you must
    --     disable this property. Default is true.
    --
    -- -   @\"indices.fielddata.cache.size\": \"80\" @ - Note the use of a
    --     string rather than a boolean. Specifies the percentage of heap space
    --     allocated to field data. Default is unbounded.
    --
    -- -   @\"indices.query.bool.max_clause_count\": \"1024\"@ - Note the use
    --     of a string rather than a boolean. Specifies the maximum number of
    --     clauses allowed in a Lucene boolean query. Default is 1,024. Queries
    --     with more than the permitted number of clauses result in a
    --     @TooManyClauses@ error.
    --
    -- -   @\"override_main_response_version\": \"true\" | \"false\"@ - Note
    --     the use of a string rather than a boolean. Specifies whether the
    --     domain reports its version as 7.10 to allow Elasticsearch OSS
    --     clients and plugins to continue working with it. Default is false
    --     when creating a domain and true when upgrading a domain.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/createupdatedomains.html#createdomain-configure-advanced-options Advanced cluster parameters>.
    CreateDomain -> Maybe (HashMap Text Text)
advancedOptions :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Options for fine-grained access control.
    CreateDomain -> Maybe AdvancedSecurityOptionsInput
advancedSecurityOptions :: Prelude.Maybe AdvancedSecurityOptionsInput,
    -- | Options for Auto-Tune.
    CreateDomain -> Maybe AutoTuneOptionsInput
autoTuneOptions :: Prelude.Maybe AutoTuneOptionsInput,
    -- | Container for the cluster configuration of a domain.
    CreateDomain -> Maybe ClusterConfig
clusterConfig :: Prelude.Maybe ClusterConfig,
    -- | Key-value pairs to configure Amazon Cognito authentication. For more
    -- information, see
    -- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/cognito-auth.html Configuring Amazon Cognito authentication for OpenSearch Dashboards>.
    CreateDomain -> Maybe CognitoOptions
cognitoOptions :: Prelude.Maybe CognitoOptions,
    -- | Additional options for the domain endpoint, such as whether to require
    -- HTTPS for all traffic.
    CreateDomain -> Maybe DomainEndpointOptions
domainEndpointOptions :: Prelude.Maybe DomainEndpointOptions,
    -- | Container for the parameters required to enable EBS-based storage for an
    -- OpenSearch Service domain.
    CreateDomain -> Maybe EBSOptions
eBSOptions :: Prelude.Maybe EBSOptions,
    -- | Key-value pairs to enable encryption at rest.
    CreateDomain -> Maybe EncryptionAtRestOptions
encryptionAtRestOptions :: Prelude.Maybe EncryptionAtRestOptions,
    -- | String of format Elasticsearch_X.Y or OpenSearch_X.Y to specify the
    -- engine version for the OpenSearch Service domain. For example,
    -- @OpenSearch_1.0@ or @Elasticsearch_7.9@. For more information, see
    -- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/createupdatedomains.html#createdomains Creating and managing Amazon OpenSearch Service domains>.
    CreateDomain -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | Key-value pairs to configure slow log publishing.
    CreateDomain -> Maybe (HashMap LogType LogPublishingOption)
logPublishingOptions :: Prelude.Maybe (Prelude.HashMap LogType LogPublishingOption),
    -- | Enables node-to-node encryption.
    CreateDomain -> Maybe NodeToNodeEncryptionOptions
nodeToNodeEncryptionOptions :: Prelude.Maybe NodeToNodeEncryptionOptions,
    -- | DEPRECATED. Container for the parameters required to configure automated
    -- snapshots of domain indexes.
    CreateDomain -> Maybe SnapshotOptions
snapshotOptions :: Prelude.Maybe SnapshotOptions,
    -- | List of tags to add to the domain upon creation.
    CreateDomain -> Maybe [Tag]
tagList :: Prelude.Maybe [Tag],
    -- | Container for the values required to configure VPC access domains. If
    -- you don\'t specify these values, OpenSearch Service creates the domain
    -- with a public endpoint. For more information, see
    -- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/vpc.html Launching your Amazon OpenSearch Service domains using a VPC>.
    CreateDomain -> Maybe VPCOptions
vPCOptions :: Prelude.Maybe VPCOptions,
    -- | Name of the OpenSearch Service domain to create. Domain names are unique
    -- across the domains owned by an account within an Amazon Web Services
    -- Region.
    CreateDomain -> Text
domainName :: Prelude.Text
  }
  deriving (CreateDomain -> CreateDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDomain -> CreateDomain -> Bool
$c/= :: CreateDomain -> CreateDomain -> Bool
== :: CreateDomain -> CreateDomain -> Bool
$c== :: CreateDomain -> CreateDomain -> Bool
Prelude.Eq, Int -> CreateDomain -> ShowS
[CreateDomain] -> ShowS
CreateDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDomain] -> ShowS
$cshowList :: [CreateDomain] -> ShowS
show :: CreateDomain -> String
$cshow :: CreateDomain -> String
showsPrec :: Int -> CreateDomain -> ShowS
$cshowsPrec :: Int -> CreateDomain -> ShowS
Prelude.Show, forall x. Rep CreateDomain x -> CreateDomain
forall x. CreateDomain -> Rep CreateDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDomain x -> CreateDomain
$cfrom :: forall x. CreateDomain -> Rep CreateDomain x
Prelude.Generic)

-- |
-- Create a value of 'CreateDomain' 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:
--
-- 'accessPolicies', 'createDomain_accessPolicies' - Identity and Access Management (IAM) policy document specifying the
-- access policies for the new domain.
--
-- 'advancedOptions', 'createDomain_advancedOptions' - Key-value pairs to specify advanced configuration options. The following
-- key-value pairs are supported:
--
-- -   @\"rest.action.multi.allow_explicit_index\": \"true\" | \"false\"@ -
--     Note the use of a string rather than a boolean. Specifies whether
--     explicit references to indexes are allowed inside the body of HTTP
--     requests. If you want to configure access policies for domain
--     sub-resources, such as specific indexes and domain APIs, you must
--     disable this property. Default is true.
--
-- -   @\"indices.fielddata.cache.size\": \"80\" @ - Note the use of a
--     string rather than a boolean. Specifies the percentage of heap space
--     allocated to field data. Default is unbounded.
--
-- -   @\"indices.query.bool.max_clause_count\": \"1024\"@ - Note the use
--     of a string rather than a boolean. Specifies the maximum number of
--     clauses allowed in a Lucene boolean query. Default is 1,024. Queries
--     with more than the permitted number of clauses result in a
--     @TooManyClauses@ error.
--
-- -   @\"override_main_response_version\": \"true\" | \"false\"@ - Note
--     the use of a string rather than a boolean. Specifies whether the
--     domain reports its version as 7.10 to allow Elasticsearch OSS
--     clients and plugins to continue working with it. Default is false
--     when creating a domain and true when upgrading a domain.
--
-- For more information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/createupdatedomains.html#createdomain-configure-advanced-options Advanced cluster parameters>.
--
-- 'advancedSecurityOptions', 'createDomain_advancedSecurityOptions' - Options for fine-grained access control.
--
-- 'autoTuneOptions', 'createDomain_autoTuneOptions' - Options for Auto-Tune.
--
-- 'clusterConfig', 'createDomain_clusterConfig' - Container for the cluster configuration of a domain.
--
-- 'cognitoOptions', 'createDomain_cognitoOptions' - Key-value pairs to configure Amazon Cognito authentication. For more
-- information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/cognito-auth.html Configuring Amazon Cognito authentication for OpenSearch Dashboards>.
--
-- 'domainEndpointOptions', 'createDomain_domainEndpointOptions' - Additional options for the domain endpoint, such as whether to require
-- HTTPS for all traffic.
--
-- 'eBSOptions', 'createDomain_eBSOptions' - Container for the parameters required to enable EBS-based storage for an
-- OpenSearch Service domain.
--
-- 'encryptionAtRestOptions', 'createDomain_encryptionAtRestOptions' - Key-value pairs to enable encryption at rest.
--
-- 'engineVersion', 'createDomain_engineVersion' - String of format Elasticsearch_X.Y or OpenSearch_X.Y to specify the
-- engine version for the OpenSearch Service domain. For example,
-- @OpenSearch_1.0@ or @Elasticsearch_7.9@. For more information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/createupdatedomains.html#createdomains Creating and managing Amazon OpenSearch Service domains>.
--
-- 'logPublishingOptions', 'createDomain_logPublishingOptions' - Key-value pairs to configure slow log publishing.
--
-- 'nodeToNodeEncryptionOptions', 'createDomain_nodeToNodeEncryptionOptions' - Enables node-to-node encryption.
--
-- 'snapshotOptions', 'createDomain_snapshotOptions' - DEPRECATED. Container for the parameters required to configure automated
-- snapshots of domain indexes.
--
-- 'tagList', 'createDomain_tagList' - List of tags to add to the domain upon creation.
--
-- 'vPCOptions', 'createDomain_vPCOptions' - Container for the values required to configure VPC access domains. If
-- you don\'t specify these values, OpenSearch Service creates the domain
-- with a public endpoint. For more information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/vpc.html Launching your Amazon OpenSearch Service domains using a VPC>.
--
-- 'domainName', 'createDomain_domainName' - Name of the OpenSearch Service domain to create. Domain names are unique
-- across the domains owned by an account within an Amazon Web Services
-- Region.
newCreateDomain ::
  -- | 'domainName'
  Prelude.Text ->
  CreateDomain
newCreateDomain :: Text -> CreateDomain
newCreateDomain Text
pDomainName_ =
  CreateDomain'
    { $sel:accessPolicies:CreateDomain' :: Maybe Text
accessPolicies = forall a. Maybe a
Prelude.Nothing,
      $sel:advancedOptions:CreateDomain' :: Maybe (HashMap Text Text)
advancedOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:advancedSecurityOptions:CreateDomain' :: Maybe AdvancedSecurityOptionsInput
advancedSecurityOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:autoTuneOptions:CreateDomain' :: Maybe AutoTuneOptionsInput
autoTuneOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterConfig:CreateDomain' :: Maybe ClusterConfig
clusterConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:cognitoOptions:CreateDomain' :: Maybe CognitoOptions
cognitoOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:domainEndpointOptions:CreateDomain' :: Maybe DomainEndpointOptions
domainEndpointOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:eBSOptions:CreateDomain' :: Maybe EBSOptions
eBSOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionAtRestOptions:CreateDomain' :: Maybe EncryptionAtRestOptions
encryptionAtRestOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:engineVersion:CreateDomain' :: Maybe Text
engineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:logPublishingOptions:CreateDomain' :: Maybe (HashMap LogType LogPublishingOption)
logPublishingOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:nodeToNodeEncryptionOptions:CreateDomain' :: Maybe NodeToNodeEncryptionOptions
nodeToNodeEncryptionOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotOptions:CreateDomain' :: Maybe SnapshotOptions
snapshotOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:tagList:CreateDomain' :: Maybe [Tag]
tagList = forall a. Maybe a
Prelude.Nothing,
      $sel:vPCOptions:CreateDomain' :: Maybe VPCOptions
vPCOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:CreateDomain' :: Text
domainName = Text
pDomainName_
    }

-- | Identity and Access Management (IAM) policy document specifying the
-- access policies for the new domain.
createDomain_accessPolicies :: Lens.Lens' CreateDomain (Prelude.Maybe Prelude.Text)
createDomain_accessPolicies :: Lens' CreateDomain (Maybe Text)
createDomain_accessPolicies = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe Text
accessPolicies :: Maybe Text
$sel:accessPolicies:CreateDomain' :: CreateDomain -> Maybe Text
accessPolicies} -> Maybe Text
accessPolicies) (\s :: CreateDomain
s@CreateDomain' {} Maybe Text
a -> CreateDomain
s {$sel:accessPolicies:CreateDomain' :: Maybe Text
accessPolicies = Maybe Text
a} :: CreateDomain)

-- | Key-value pairs to specify advanced configuration options. The following
-- key-value pairs are supported:
--
-- -   @\"rest.action.multi.allow_explicit_index\": \"true\" | \"false\"@ -
--     Note the use of a string rather than a boolean. Specifies whether
--     explicit references to indexes are allowed inside the body of HTTP
--     requests. If you want to configure access policies for domain
--     sub-resources, such as specific indexes and domain APIs, you must
--     disable this property. Default is true.
--
-- -   @\"indices.fielddata.cache.size\": \"80\" @ - Note the use of a
--     string rather than a boolean. Specifies the percentage of heap space
--     allocated to field data. Default is unbounded.
--
-- -   @\"indices.query.bool.max_clause_count\": \"1024\"@ - Note the use
--     of a string rather than a boolean. Specifies the maximum number of
--     clauses allowed in a Lucene boolean query. Default is 1,024. Queries
--     with more than the permitted number of clauses result in a
--     @TooManyClauses@ error.
--
-- -   @\"override_main_response_version\": \"true\" | \"false\"@ - Note
--     the use of a string rather than a boolean. Specifies whether the
--     domain reports its version as 7.10 to allow Elasticsearch OSS
--     clients and plugins to continue working with it. Default is false
--     when creating a domain and true when upgrading a domain.
--
-- For more information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/createupdatedomains.html#createdomain-configure-advanced-options Advanced cluster parameters>.
createDomain_advancedOptions :: Lens.Lens' CreateDomain (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createDomain_advancedOptions :: Lens' CreateDomain (Maybe (HashMap Text Text))
createDomain_advancedOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe (HashMap Text Text)
advancedOptions :: Maybe (HashMap Text Text)
$sel:advancedOptions:CreateDomain' :: CreateDomain -> Maybe (HashMap Text Text)
advancedOptions} -> Maybe (HashMap Text Text)
advancedOptions) (\s :: CreateDomain
s@CreateDomain' {} Maybe (HashMap Text Text)
a -> CreateDomain
s {$sel:advancedOptions:CreateDomain' :: Maybe (HashMap Text Text)
advancedOptions = Maybe (HashMap Text Text)
a} :: CreateDomain) 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

-- | Options for fine-grained access control.
createDomain_advancedSecurityOptions :: Lens.Lens' CreateDomain (Prelude.Maybe AdvancedSecurityOptionsInput)
createDomain_advancedSecurityOptions :: Lens' CreateDomain (Maybe AdvancedSecurityOptionsInput)
createDomain_advancedSecurityOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe AdvancedSecurityOptionsInput
advancedSecurityOptions :: Maybe AdvancedSecurityOptionsInput
$sel:advancedSecurityOptions:CreateDomain' :: CreateDomain -> Maybe AdvancedSecurityOptionsInput
advancedSecurityOptions} -> Maybe AdvancedSecurityOptionsInput
advancedSecurityOptions) (\s :: CreateDomain
s@CreateDomain' {} Maybe AdvancedSecurityOptionsInput
a -> CreateDomain
s {$sel:advancedSecurityOptions:CreateDomain' :: Maybe AdvancedSecurityOptionsInput
advancedSecurityOptions = Maybe AdvancedSecurityOptionsInput
a} :: CreateDomain)

-- | Options for Auto-Tune.
createDomain_autoTuneOptions :: Lens.Lens' CreateDomain (Prelude.Maybe AutoTuneOptionsInput)
createDomain_autoTuneOptions :: Lens' CreateDomain (Maybe AutoTuneOptionsInput)
createDomain_autoTuneOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe AutoTuneOptionsInput
autoTuneOptions :: Maybe AutoTuneOptionsInput
$sel:autoTuneOptions:CreateDomain' :: CreateDomain -> Maybe AutoTuneOptionsInput
autoTuneOptions} -> Maybe AutoTuneOptionsInput
autoTuneOptions) (\s :: CreateDomain
s@CreateDomain' {} Maybe AutoTuneOptionsInput
a -> CreateDomain
s {$sel:autoTuneOptions:CreateDomain' :: Maybe AutoTuneOptionsInput
autoTuneOptions = Maybe AutoTuneOptionsInput
a} :: CreateDomain)

-- | Container for the cluster configuration of a domain.
createDomain_clusterConfig :: Lens.Lens' CreateDomain (Prelude.Maybe ClusterConfig)
createDomain_clusterConfig :: Lens' CreateDomain (Maybe ClusterConfig)
createDomain_clusterConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe ClusterConfig
clusterConfig :: Maybe ClusterConfig
$sel:clusterConfig:CreateDomain' :: CreateDomain -> Maybe ClusterConfig
clusterConfig} -> Maybe ClusterConfig
clusterConfig) (\s :: CreateDomain
s@CreateDomain' {} Maybe ClusterConfig
a -> CreateDomain
s {$sel:clusterConfig:CreateDomain' :: Maybe ClusterConfig
clusterConfig = Maybe ClusterConfig
a} :: CreateDomain)

-- | Key-value pairs to configure Amazon Cognito authentication. For more
-- information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/cognito-auth.html Configuring Amazon Cognito authentication for OpenSearch Dashboards>.
createDomain_cognitoOptions :: Lens.Lens' CreateDomain (Prelude.Maybe CognitoOptions)
createDomain_cognitoOptions :: Lens' CreateDomain (Maybe CognitoOptions)
createDomain_cognitoOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe CognitoOptions
cognitoOptions :: Maybe CognitoOptions
$sel:cognitoOptions:CreateDomain' :: CreateDomain -> Maybe CognitoOptions
cognitoOptions} -> Maybe CognitoOptions
cognitoOptions) (\s :: CreateDomain
s@CreateDomain' {} Maybe CognitoOptions
a -> CreateDomain
s {$sel:cognitoOptions:CreateDomain' :: Maybe CognitoOptions
cognitoOptions = Maybe CognitoOptions
a} :: CreateDomain)

-- | Additional options for the domain endpoint, such as whether to require
-- HTTPS for all traffic.
createDomain_domainEndpointOptions :: Lens.Lens' CreateDomain (Prelude.Maybe DomainEndpointOptions)
createDomain_domainEndpointOptions :: Lens' CreateDomain (Maybe DomainEndpointOptions)
createDomain_domainEndpointOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe DomainEndpointOptions
domainEndpointOptions :: Maybe DomainEndpointOptions
$sel:domainEndpointOptions:CreateDomain' :: CreateDomain -> Maybe DomainEndpointOptions
domainEndpointOptions} -> Maybe DomainEndpointOptions
domainEndpointOptions) (\s :: CreateDomain
s@CreateDomain' {} Maybe DomainEndpointOptions
a -> CreateDomain
s {$sel:domainEndpointOptions:CreateDomain' :: Maybe DomainEndpointOptions
domainEndpointOptions = Maybe DomainEndpointOptions
a} :: CreateDomain)

-- | Container for the parameters required to enable EBS-based storage for an
-- OpenSearch Service domain.
createDomain_eBSOptions :: Lens.Lens' CreateDomain (Prelude.Maybe EBSOptions)
createDomain_eBSOptions :: Lens' CreateDomain (Maybe EBSOptions)
createDomain_eBSOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe EBSOptions
eBSOptions :: Maybe EBSOptions
$sel:eBSOptions:CreateDomain' :: CreateDomain -> Maybe EBSOptions
eBSOptions} -> Maybe EBSOptions
eBSOptions) (\s :: CreateDomain
s@CreateDomain' {} Maybe EBSOptions
a -> CreateDomain
s {$sel:eBSOptions:CreateDomain' :: Maybe EBSOptions
eBSOptions = Maybe EBSOptions
a} :: CreateDomain)

-- | Key-value pairs to enable encryption at rest.
createDomain_encryptionAtRestOptions :: Lens.Lens' CreateDomain (Prelude.Maybe EncryptionAtRestOptions)
createDomain_encryptionAtRestOptions :: Lens' CreateDomain (Maybe EncryptionAtRestOptions)
createDomain_encryptionAtRestOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe EncryptionAtRestOptions
encryptionAtRestOptions :: Maybe EncryptionAtRestOptions
$sel:encryptionAtRestOptions:CreateDomain' :: CreateDomain -> Maybe EncryptionAtRestOptions
encryptionAtRestOptions} -> Maybe EncryptionAtRestOptions
encryptionAtRestOptions) (\s :: CreateDomain
s@CreateDomain' {} Maybe EncryptionAtRestOptions
a -> CreateDomain
s {$sel:encryptionAtRestOptions:CreateDomain' :: Maybe EncryptionAtRestOptions
encryptionAtRestOptions = Maybe EncryptionAtRestOptions
a} :: CreateDomain)

-- | String of format Elasticsearch_X.Y or OpenSearch_X.Y to specify the
-- engine version for the OpenSearch Service domain. For example,
-- @OpenSearch_1.0@ or @Elasticsearch_7.9@. For more information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/createupdatedomains.html#createdomains Creating and managing Amazon OpenSearch Service domains>.
createDomain_engineVersion :: Lens.Lens' CreateDomain (Prelude.Maybe Prelude.Text)
createDomain_engineVersion :: Lens' CreateDomain (Maybe Text)
createDomain_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe Text
engineVersion :: Maybe Text
$sel:engineVersion:CreateDomain' :: CreateDomain -> Maybe Text
engineVersion} -> Maybe Text
engineVersion) (\s :: CreateDomain
s@CreateDomain' {} Maybe Text
a -> CreateDomain
s {$sel:engineVersion:CreateDomain' :: Maybe Text
engineVersion = Maybe Text
a} :: CreateDomain)

-- | Key-value pairs to configure slow log publishing.
createDomain_logPublishingOptions :: Lens.Lens' CreateDomain (Prelude.Maybe (Prelude.HashMap LogType LogPublishingOption))
createDomain_logPublishingOptions :: Lens' CreateDomain (Maybe (HashMap LogType LogPublishingOption))
createDomain_logPublishingOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe (HashMap LogType LogPublishingOption)
logPublishingOptions :: Maybe (HashMap LogType LogPublishingOption)
$sel:logPublishingOptions:CreateDomain' :: CreateDomain -> Maybe (HashMap LogType LogPublishingOption)
logPublishingOptions} -> Maybe (HashMap LogType LogPublishingOption)
logPublishingOptions) (\s :: CreateDomain
s@CreateDomain' {} Maybe (HashMap LogType LogPublishingOption)
a -> CreateDomain
s {$sel:logPublishingOptions:CreateDomain' :: Maybe (HashMap LogType LogPublishingOption)
logPublishingOptions = Maybe (HashMap LogType LogPublishingOption)
a} :: CreateDomain) 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

-- | Enables node-to-node encryption.
createDomain_nodeToNodeEncryptionOptions :: Lens.Lens' CreateDomain (Prelude.Maybe NodeToNodeEncryptionOptions)
createDomain_nodeToNodeEncryptionOptions :: Lens' CreateDomain (Maybe NodeToNodeEncryptionOptions)
createDomain_nodeToNodeEncryptionOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe NodeToNodeEncryptionOptions
nodeToNodeEncryptionOptions :: Maybe NodeToNodeEncryptionOptions
$sel:nodeToNodeEncryptionOptions:CreateDomain' :: CreateDomain -> Maybe NodeToNodeEncryptionOptions
nodeToNodeEncryptionOptions} -> Maybe NodeToNodeEncryptionOptions
nodeToNodeEncryptionOptions) (\s :: CreateDomain
s@CreateDomain' {} Maybe NodeToNodeEncryptionOptions
a -> CreateDomain
s {$sel:nodeToNodeEncryptionOptions:CreateDomain' :: Maybe NodeToNodeEncryptionOptions
nodeToNodeEncryptionOptions = Maybe NodeToNodeEncryptionOptions
a} :: CreateDomain)

-- | DEPRECATED. Container for the parameters required to configure automated
-- snapshots of domain indexes.
createDomain_snapshotOptions :: Lens.Lens' CreateDomain (Prelude.Maybe SnapshotOptions)
createDomain_snapshotOptions :: Lens' CreateDomain (Maybe SnapshotOptions)
createDomain_snapshotOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe SnapshotOptions
snapshotOptions :: Maybe SnapshotOptions
$sel:snapshotOptions:CreateDomain' :: CreateDomain -> Maybe SnapshotOptions
snapshotOptions} -> Maybe SnapshotOptions
snapshotOptions) (\s :: CreateDomain
s@CreateDomain' {} Maybe SnapshotOptions
a -> CreateDomain
s {$sel:snapshotOptions:CreateDomain' :: Maybe SnapshotOptions
snapshotOptions = Maybe SnapshotOptions
a} :: CreateDomain)

-- | List of tags to add to the domain upon creation.
createDomain_tagList :: Lens.Lens' CreateDomain (Prelude.Maybe [Tag])
createDomain_tagList :: Lens' CreateDomain (Maybe [Tag])
createDomain_tagList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe [Tag]
tagList :: Maybe [Tag]
$sel:tagList:CreateDomain' :: CreateDomain -> Maybe [Tag]
tagList} -> Maybe [Tag]
tagList) (\s :: CreateDomain
s@CreateDomain' {} Maybe [Tag]
a -> CreateDomain
s {$sel:tagList:CreateDomain' :: Maybe [Tag]
tagList = Maybe [Tag]
a} :: CreateDomain) 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

-- | Container for the values required to configure VPC access domains. If
-- you don\'t specify these values, OpenSearch Service creates the domain
-- with a public endpoint. For more information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/vpc.html Launching your Amazon OpenSearch Service domains using a VPC>.
createDomain_vPCOptions :: Lens.Lens' CreateDomain (Prelude.Maybe VPCOptions)
createDomain_vPCOptions :: Lens' CreateDomain (Maybe VPCOptions)
createDomain_vPCOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe VPCOptions
vPCOptions :: Maybe VPCOptions
$sel:vPCOptions:CreateDomain' :: CreateDomain -> Maybe VPCOptions
vPCOptions} -> Maybe VPCOptions
vPCOptions) (\s :: CreateDomain
s@CreateDomain' {} Maybe VPCOptions
a -> CreateDomain
s {$sel:vPCOptions:CreateDomain' :: Maybe VPCOptions
vPCOptions = Maybe VPCOptions
a} :: CreateDomain)

-- | Name of the OpenSearch Service domain to create. Domain names are unique
-- across the domains owned by an account within an Amazon Web Services
-- Region.
createDomain_domainName :: Lens.Lens' CreateDomain Prelude.Text
createDomain_domainName :: Lens' CreateDomain Text
createDomain_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Text
domainName :: Text
$sel:domainName:CreateDomain' :: CreateDomain -> Text
domainName} -> Text
domainName) (\s :: CreateDomain
s@CreateDomain' {} Text
a -> CreateDomain
s {$sel:domainName:CreateDomain' :: Text
domainName = Text
a} :: CreateDomain)

instance Core.AWSRequest CreateDomain where
  type AWSResponse CreateDomain = CreateDomainResponse
  request :: (Service -> Service) -> CreateDomain -> Request CreateDomain
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 CreateDomain
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateDomain)))
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 DomainStatus -> Int -> CreateDomainResponse
CreateDomainResponse'
            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
"DomainStatus")
            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 CreateDomain where
  hashWithSalt :: Int -> CreateDomain -> Int
hashWithSalt Int
_salt CreateDomain' {Maybe [Tag]
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap LogType LogPublishingOption)
Maybe CognitoOptions
Maybe EncryptionAtRestOptions
Maybe NodeToNodeEncryptionOptions
Maybe AdvancedSecurityOptionsInput
Maybe SnapshotOptions
Maybe DomainEndpointOptions
Maybe AutoTuneOptionsInput
Maybe VPCOptions
Maybe EBSOptions
Maybe ClusterConfig
Text
domainName :: Text
vPCOptions :: Maybe VPCOptions
tagList :: Maybe [Tag]
snapshotOptions :: Maybe SnapshotOptions
nodeToNodeEncryptionOptions :: Maybe NodeToNodeEncryptionOptions
logPublishingOptions :: Maybe (HashMap LogType LogPublishingOption)
engineVersion :: Maybe Text
encryptionAtRestOptions :: Maybe EncryptionAtRestOptions
eBSOptions :: Maybe EBSOptions
domainEndpointOptions :: Maybe DomainEndpointOptions
cognitoOptions :: Maybe CognitoOptions
clusterConfig :: Maybe ClusterConfig
autoTuneOptions :: Maybe AutoTuneOptionsInput
advancedSecurityOptions :: Maybe AdvancedSecurityOptionsInput
advancedOptions :: Maybe (HashMap Text Text)
accessPolicies :: Maybe Text
$sel:domainName:CreateDomain' :: CreateDomain -> Text
$sel:vPCOptions:CreateDomain' :: CreateDomain -> Maybe VPCOptions
$sel:tagList:CreateDomain' :: CreateDomain -> Maybe [Tag]
$sel:snapshotOptions:CreateDomain' :: CreateDomain -> Maybe SnapshotOptions
$sel:nodeToNodeEncryptionOptions:CreateDomain' :: CreateDomain -> Maybe NodeToNodeEncryptionOptions
$sel:logPublishingOptions:CreateDomain' :: CreateDomain -> Maybe (HashMap LogType LogPublishingOption)
$sel:engineVersion:CreateDomain' :: CreateDomain -> Maybe Text
$sel:encryptionAtRestOptions:CreateDomain' :: CreateDomain -> Maybe EncryptionAtRestOptions
$sel:eBSOptions:CreateDomain' :: CreateDomain -> Maybe EBSOptions
$sel:domainEndpointOptions:CreateDomain' :: CreateDomain -> Maybe DomainEndpointOptions
$sel:cognitoOptions:CreateDomain' :: CreateDomain -> Maybe CognitoOptions
$sel:clusterConfig:CreateDomain' :: CreateDomain -> Maybe ClusterConfig
$sel:autoTuneOptions:CreateDomain' :: CreateDomain -> Maybe AutoTuneOptionsInput
$sel:advancedSecurityOptions:CreateDomain' :: CreateDomain -> Maybe AdvancedSecurityOptionsInput
$sel:advancedOptions:CreateDomain' :: CreateDomain -> Maybe (HashMap Text Text)
$sel:accessPolicies:CreateDomain' :: CreateDomain -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accessPolicies
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
advancedOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AdvancedSecurityOptionsInput
advancedSecurityOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoTuneOptionsInput
autoTuneOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClusterConfig
clusterConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CognitoOptions
cognitoOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DomainEndpointOptions
domainEndpointOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EBSOptions
eBSOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncryptionAtRestOptions
encryptionAtRestOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap LogType LogPublishingOption)
logPublishingOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NodeToNodeEncryptionOptions
nodeToNodeEncryptionOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SnapshotOptions
snapshotOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tagList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VPCOptions
vPCOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData CreateDomain where
  rnf :: CreateDomain -> ()
rnf CreateDomain' {Maybe [Tag]
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap LogType LogPublishingOption)
Maybe CognitoOptions
Maybe EncryptionAtRestOptions
Maybe NodeToNodeEncryptionOptions
Maybe AdvancedSecurityOptionsInput
Maybe SnapshotOptions
Maybe DomainEndpointOptions
Maybe AutoTuneOptionsInput
Maybe VPCOptions
Maybe EBSOptions
Maybe ClusterConfig
Text
domainName :: Text
vPCOptions :: Maybe VPCOptions
tagList :: Maybe [Tag]
snapshotOptions :: Maybe SnapshotOptions
nodeToNodeEncryptionOptions :: Maybe NodeToNodeEncryptionOptions
logPublishingOptions :: Maybe (HashMap LogType LogPublishingOption)
engineVersion :: Maybe Text
encryptionAtRestOptions :: Maybe EncryptionAtRestOptions
eBSOptions :: Maybe EBSOptions
domainEndpointOptions :: Maybe DomainEndpointOptions
cognitoOptions :: Maybe CognitoOptions
clusterConfig :: Maybe ClusterConfig
autoTuneOptions :: Maybe AutoTuneOptionsInput
advancedSecurityOptions :: Maybe AdvancedSecurityOptionsInput
advancedOptions :: Maybe (HashMap Text Text)
accessPolicies :: Maybe Text
$sel:domainName:CreateDomain' :: CreateDomain -> Text
$sel:vPCOptions:CreateDomain' :: CreateDomain -> Maybe VPCOptions
$sel:tagList:CreateDomain' :: CreateDomain -> Maybe [Tag]
$sel:snapshotOptions:CreateDomain' :: CreateDomain -> Maybe SnapshotOptions
$sel:nodeToNodeEncryptionOptions:CreateDomain' :: CreateDomain -> Maybe NodeToNodeEncryptionOptions
$sel:logPublishingOptions:CreateDomain' :: CreateDomain -> Maybe (HashMap LogType LogPublishingOption)
$sel:engineVersion:CreateDomain' :: CreateDomain -> Maybe Text
$sel:encryptionAtRestOptions:CreateDomain' :: CreateDomain -> Maybe EncryptionAtRestOptions
$sel:eBSOptions:CreateDomain' :: CreateDomain -> Maybe EBSOptions
$sel:domainEndpointOptions:CreateDomain' :: CreateDomain -> Maybe DomainEndpointOptions
$sel:cognitoOptions:CreateDomain' :: CreateDomain -> Maybe CognitoOptions
$sel:clusterConfig:CreateDomain' :: CreateDomain -> Maybe ClusterConfig
$sel:autoTuneOptions:CreateDomain' :: CreateDomain -> Maybe AutoTuneOptionsInput
$sel:advancedSecurityOptions:CreateDomain' :: CreateDomain -> Maybe AdvancedSecurityOptionsInput
$sel:advancedOptions:CreateDomain' :: CreateDomain -> Maybe (HashMap Text Text)
$sel:accessPolicies:CreateDomain' :: CreateDomain -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accessPolicies
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
advancedOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AdvancedSecurityOptionsInput
advancedSecurityOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoTuneOptionsInput
autoTuneOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClusterConfig
clusterConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CognitoOptions
cognitoOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DomainEndpointOptions
domainEndpointOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EBSOptions
eBSOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionAtRestOptions
encryptionAtRestOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap LogType LogPublishingOption)
logPublishingOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NodeToNodeEncryptionOptions
nodeToNodeEncryptionOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SnapshotOptions
snapshotOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tagList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VPCOptions
vPCOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName

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

instance Data.ToJSON CreateDomain where
  toJSON :: CreateDomain -> Value
toJSON CreateDomain' {Maybe [Tag]
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap LogType LogPublishingOption)
Maybe CognitoOptions
Maybe EncryptionAtRestOptions
Maybe NodeToNodeEncryptionOptions
Maybe AdvancedSecurityOptionsInput
Maybe SnapshotOptions
Maybe DomainEndpointOptions
Maybe AutoTuneOptionsInput
Maybe VPCOptions
Maybe EBSOptions
Maybe ClusterConfig
Text
domainName :: Text
vPCOptions :: Maybe VPCOptions
tagList :: Maybe [Tag]
snapshotOptions :: Maybe SnapshotOptions
nodeToNodeEncryptionOptions :: Maybe NodeToNodeEncryptionOptions
logPublishingOptions :: Maybe (HashMap LogType LogPublishingOption)
engineVersion :: Maybe Text
encryptionAtRestOptions :: Maybe EncryptionAtRestOptions
eBSOptions :: Maybe EBSOptions
domainEndpointOptions :: Maybe DomainEndpointOptions
cognitoOptions :: Maybe CognitoOptions
clusterConfig :: Maybe ClusterConfig
autoTuneOptions :: Maybe AutoTuneOptionsInput
advancedSecurityOptions :: Maybe AdvancedSecurityOptionsInput
advancedOptions :: Maybe (HashMap Text Text)
accessPolicies :: Maybe Text
$sel:domainName:CreateDomain' :: CreateDomain -> Text
$sel:vPCOptions:CreateDomain' :: CreateDomain -> Maybe VPCOptions
$sel:tagList:CreateDomain' :: CreateDomain -> Maybe [Tag]
$sel:snapshotOptions:CreateDomain' :: CreateDomain -> Maybe SnapshotOptions
$sel:nodeToNodeEncryptionOptions:CreateDomain' :: CreateDomain -> Maybe NodeToNodeEncryptionOptions
$sel:logPublishingOptions:CreateDomain' :: CreateDomain -> Maybe (HashMap LogType LogPublishingOption)
$sel:engineVersion:CreateDomain' :: CreateDomain -> Maybe Text
$sel:encryptionAtRestOptions:CreateDomain' :: CreateDomain -> Maybe EncryptionAtRestOptions
$sel:eBSOptions:CreateDomain' :: CreateDomain -> Maybe EBSOptions
$sel:domainEndpointOptions:CreateDomain' :: CreateDomain -> Maybe DomainEndpointOptions
$sel:cognitoOptions:CreateDomain' :: CreateDomain -> Maybe CognitoOptions
$sel:clusterConfig:CreateDomain' :: CreateDomain -> Maybe ClusterConfig
$sel:autoTuneOptions:CreateDomain' :: CreateDomain -> Maybe AutoTuneOptionsInput
$sel:advancedSecurityOptions:CreateDomain' :: CreateDomain -> Maybe AdvancedSecurityOptionsInput
$sel:advancedOptions:CreateDomain' :: CreateDomain -> Maybe (HashMap Text Text)
$sel:accessPolicies:CreateDomain' :: CreateDomain -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccessPolicies" 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
accessPolicies,
            (Key
"AdvancedOptions" 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 (HashMap Text Text)
advancedOptions,
            (Key
"AdvancedSecurityOptions" 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 AdvancedSecurityOptionsInput
advancedSecurityOptions,
            (Key
"AutoTuneOptions" 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 AutoTuneOptionsInput
autoTuneOptions,
            (Key
"ClusterConfig" 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 ClusterConfig
clusterConfig,
            (Key
"CognitoOptions" 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 CognitoOptions
cognitoOptions,
            (Key
"DomainEndpointOptions" 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 DomainEndpointOptions
domainEndpointOptions,
            (Key
"EBSOptions" 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 EBSOptions
eBSOptions,
            (Key
"EncryptionAtRestOptions" 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 EncryptionAtRestOptions
encryptionAtRestOptions,
            (Key
"EngineVersion" 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
engineVersion,
            (Key
"LogPublishingOptions" 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 (HashMap LogType LogPublishingOption)
logPublishingOptions,
            (Key
"NodeToNodeEncryptionOptions" 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 NodeToNodeEncryptionOptions
nodeToNodeEncryptionOptions,
            (Key
"SnapshotOptions" 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 SnapshotOptions
snapshotOptions,
            (Key
"TagList" 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]
tagList,
            (Key
"VPCOptions" 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 VPCOptions
vPCOptions,
            forall a. a -> Maybe a
Prelude.Just (Key
"DomainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainName)
          ]
      )

instance Data.ToPath CreateDomain where
  toPath :: CreateDomain -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const ByteString
"/2021-01-01/opensearch/domain"

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

-- | The result of a @CreateDomain@ operation. Contains the status of the
-- newly created domain.
--
-- /See:/ 'newCreateDomainResponse' smart constructor.
data CreateDomainResponse = CreateDomainResponse'
  { -- | The status of the newly created domain.
    CreateDomainResponse -> Maybe DomainStatus
domainStatus :: Prelude.Maybe DomainStatus,
    -- | The response's http status code.
    CreateDomainResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDomainResponse -> CreateDomainResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDomainResponse -> CreateDomainResponse -> Bool
$c/= :: CreateDomainResponse -> CreateDomainResponse -> Bool
== :: CreateDomainResponse -> CreateDomainResponse -> Bool
$c== :: CreateDomainResponse -> CreateDomainResponse -> Bool
Prelude.Eq, ReadPrec [CreateDomainResponse]
ReadPrec CreateDomainResponse
Int -> ReadS CreateDomainResponse
ReadS [CreateDomainResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDomainResponse]
$creadListPrec :: ReadPrec [CreateDomainResponse]
readPrec :: ReadPrec CreateDomainResponse
$creadPrec :: ReadPrec CreateDomainResponse
readList :: ReadS [CreateDomainResponse]
$creadList :: ReadS [CreateDomainResponse]
readsPrec :: Int -> ReadS CreateDomainResponse
$creadsPrec :: Int -> ReadS CreateDomainResponse
Prelude.Read, Int -> CreateDomainResponse -> ShowS
[CreateDomainResponse] -> ShowS
CreateDomainResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDomainResponse] -> ShowS
$cshowList :: [CreateDomainResponse] -> ShowS
show :: CreateDomainResponse -> String
$cshow :: CreateDomainResponse -> String
showsPrec :: Int -> CreateDomainResponse -> ShowS
$cshowsPrec :: Int -> CreateDomainResponse -> ShowS
Prelude.Show, forall x. Rep CreateDomainResponse x -> CreateDomainResponse
forall x. CreateDomainResponse -> Rep CreateDomainResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDomainResponse x -> CreateDomainResponse
$cfrom :: forall x. CreateDomainResponse -> Rep CreateDomainResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDomainResponse' 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:
--
-- 'domainStatus', 'createDomainResponse_domainStatus' - The status of the newly created domain.
--
-- 'httpStatus', 'createDomainResponse_httpStatus' - The response's http status code.
newCreateDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDomainResponse
newCreateDomainResponse :: Int -> CreateDomainResponse
newCreateDomainResponse Int
pHttpStatus_ =
  CreateDomainResponse'
    { $sel:domainStatus:CreateDomainResponse' :: Maybe DomainStatus
domainStatus =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDomainResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The status of the newly created domain.
createDomainResponse_domainStatus :: Lens.Lens' CreateDomainResponse (Prelude.Maybe DomainStatus)
createDomainResponse_domainStatus :: Lens' CreateDomainResponse (Maybe DomainStatus)
createDomainResponse_domainStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainResponse' {Maybe DomainStatus
domainStatus :: Maybe DomainStatus
$sel:domainStatus:CreateDomainResponse' :: CreateDomainResponse -> Maybe DomainStatus
domainStatus} -> Maybe DomainStatus
domainStatus) (\s :: CreateDomainResponse
s@CreateDomainResponse' {} Maybe DomainStatus
a -> CreateDomainResponse
s {$sel:domainStatus:CreateDomainResponse' :: Maybe DomainStatus
domainStatus = Maybe DomainStatus
a} :: CreateDomainResponse)

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

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