{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.SageMaker.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 a @Domain@ used by Amazon SageMaker Studio. A domain consists of
-- an associated Amazon Elastic File System (EFS) volume, a list of
-- authorized users, and a variety of security, application, policy, and
-- Amazon Virtual Private Cloud (VPC) configurations. An Amazon Web
-- Services account is limited to one domain per region. Users within a
-- domain can share notebook files and other artifacts with each other.
--
-- __EFS storage__
--
-- When a domain is created, an EFS volume is created for use by all of the
-- users within the domain. Each user receives a private home directory
-- within the EFS volume for notebooks, Git repositories, and data files.
--
-- SageMaker uses the Amazon Web Services Key Management Service (Amazon
-- Web Services KMS) to encrypt the EFS volume attached to the domain with
-- an Amazon Web Services managed key by default. For more control, you can
-- specify a customer managed key. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/encryption-at-rest.html Protect Data at Rest Using Encryption>.
--
-- __VPC configuration__
--
-- All SageMaker Studio traffic between the domain and the EFS volume is
-- through the specified VPC and subnets. For other Studio traffic, you can
-- specify the @AppNetworkAccessType@ parameter. @AppNetworkAccessType@
-- corresponds to the network access type that you choose when you onboard
-- to Studio. The following options are available:
--
-- -   @PublicInternetOnly@ - Non-EFS traffic goes through a VPC managed by
--     Amazon SageMaker, which allows internet access. This is the default
--     value.
--
-- -   @VpcOnly@ - All Studio traffic is through the specified VPC and
--     subnets. Internet access is disabled by default. To allow internet
--     access, you must specify a NAT gateway.
--
--     When internet access is disabled, you won\'t be able to run a Studio
--     notebook or to train or host models unless your VPC has an interface
--     endpoint to the SageMaker API and runtime or a NAT gateway and your
--     security groups allow outbound connections.
--
-- NFS traffic over TCP on port 2049 needs to be allowed in both inbound
-- and outbound rules in order to launch a SageMaker Studio app
-- successfully.
--
-- For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/studio-notebooks-and-internet-access.html Connect SageMaker Studio Notebooks to Resources in a VPC>.
module Amazonka.SageMaker.CreateDomain
  ( -- * Creating a Request
    CreateDomain (..),
    newCreateDomain,

    -- * Request Lenses
    createDomain_appNetworkAccessType,
    createDomain_appSecurityGroupManagement,
    createDomain_defaultSpaceSettings,
    createDomain_domainSettings,
    createDomain_homeEfsFileSystemKmsKeyId,
    createDomain_kmsKeyId,
    createDomain_tags,
    createDomain_domainName,
    createDomain_authMode,
    createDomain_defaultUserSettings,
    createDomain_subnetIds,
    createDomain_vpcId,

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

    -- * Response Lenses
    createDomainResponse_domainArn,
    createDomainResponse_url,
    createDomainResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateDomain' smart constructor.
data CreateDomain = CreateDomain'
  { -- | Specifies the VPC used for non-EFS traffic. The default value is
    -- @PublicInternetOnly@.
    --
    -- -   @PublicInternetOnly@ - Non-EFS traffic is through a VPC managed by
    --     Amazon SageMaker, which allows direct internet access
    --
    -- -   @VpcOnly@ - All Studio traffic is through the specified VPC and
    --     subnets
    CreateDomain -> Maybe AppNetworkAccessType
appNetworkAccessType :: Prelude.Maybe AppNetworkAccessType,
    -- | The entity that creates and manages the required security groups for
    -- inter-app communication in @VPCOnly@ mode. Required when
    -- @CreateDomain.AppNetworkAccessType@ is @VPCOnly@ and
    -- @DomainSettings.RStudioServerProDomainSettings.DomainExecutionRoleArn@
    -- is provided.
    CreateDomain -> Maybe AppSecurityGroupManagement
appSecurityGroupManagement :: Prelude.Maybe AppSecurityGroupManagement,
    -- | The default settings used to create a space.
    CreateDomain -> Maybe DefaultSpaceSettings
defaultSpaceSettings :: Prelude.Maybe DefaultSpaceSettings,
    -- | A collection of @Domain@ settings.
    CreateDomain -> Maybe DomainSettings
domainSettings :: Prelude.Maybe DomainSettings,
    -- | Use @KmsKeyId@.
    CreateDomain -> Maybe Text
homeEfsFileSystemKmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | SageMaker uses Amazon Web Services KMS to encrypt the EFS volume
    -- attached to the domain with an Amazon Web Services managed key by
    -- default. For more control, specify a customer managed key.
    CreateDomain -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | Tags to associated with the Domain. Each tag consists of a key and an
    -- optional value. Tag keys must be unique per resource. Tags are
    -- searchable using the @Search@ API.
    --
    -- Tags that you specify for the Domain are also added to all Apps that the
    -- Domain launches.
    CreateDomain -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A name for the domain.
    CreateDomain -> Text
domainName :: Prelude.Text,
    -- | The mode of authentication that members use to access the domain.
    CreateDomain -> AuthMode
authMode :: AuthMode,
    -- | The default settings to use to create a user profile when @UserSettings@
    -- isn\'t specified in the call to the @CreateUserProfile@ API.
    --
    -- @SecurityGroups@ is aggregated when specified in both calls. For all
    -- other settings in @UserSettings@, the values specified in
    -- @CreateUserProfile@ take precedence over those specified in
    -- @CreateDomain@.
    CreateDomain -> UserSettings
defaultUserSettings :: UserSettings,
    -- | The VPC subnets that Studio uses for communication.
    CreateDomain -> NonEmpty Text
subnetIds :: Prelude.NonEmpty Prelude.Text,
    -- | The ID of the Amazon Virtual Private Cloud (VPC) that Studio uses for
    -- communication.
    CreateDomain -> Text
vpcId :: 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, ReadPrec [CreateDomain]
ReadPrec CreateDomain
Int -> ReadS CreateDomain
ReadS [CreateDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDomain]
$creadListPrec :: ReadPrec [CreateDomain]
readPrec :: ReadPrec CreateDomain
$creadPrec :: ReadPrec CreateDomain
readList :: ReadS [CreateDomain]
$creadList :: ReadS [CreateDomain]
readsPrec :: Int -> ReadS CreateDomain
$creadsPrec :: Int -> ReadS CreateDomain
Prelude.Read, 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:
--
-- 'appNetworkAccessType', 'createDomain_appNetworkAccessType' - Specifies the VPC used for non-EFS traffic. The default value is
-- @PublicInternetOnly@.
--
-- -   @PublicInternetOnly@ - Non-EFS traffic is through a VPC managed by
--     Amazon SageMaker, which allows direct internet access
--
-- -   @VpcOnly@ - All Studio traffic is through the specified VPC and
--     subnets
--
-- 'appSecurityGroupManagement', 'createDomain_appSecurityGroupManagement' - The entity that creates and manages the required security groups for
-- inter-app communication in @VPCOnly@ mode. Required when
-- @CreateDomain.AppNetworkAccessType@ is @VPCOnly@ and
-- @DomainSettings.RStudioServerProDomainSettings.DomainExecutionRoleArn@
-- is provided.
--
-- 'defaultSpaceSettings', 'createDomain_defaultSpaceSettings' - The default settings used to create a space.
--
-- 'domainSettings', 'createDomain_domainSettings' - A collection of @Domain@ settings.
--
-- 'homeEfsFileSystemKmsKeyId', 'createDomain_homeEfsFileSystemKmsKeyId' - Use @KmsKeyId@.
--
-- 'kmsKeyId', 'createDomain_kmsKeyId' - SageMaker uses Amazon Web Services KMS to encrypt the EFS volume
-- attached to the domain with an Amazon Web Services managed key by
-- default. For more control, specify a customer managed key.
--
-- 'tags', 'createDomain_tags' - Tags to associated with the Domain. Each tag consists of a key and an
-- optional value. Tag keys must be unique per resource. Tags are
-- searchable using the @Search@ API.
--
-- Tags that you specify for the Domain are also added to all Apps that the
-- Domain launches.
--
-- 'domainName', 'createDomain_domainName' - A name for the domain.
--
-- 'authMode', 'createDomain_authMode' - The mode of authentication that members use to access the domain.
--
-- 'defaultUserSettings', 'createDomain_defaultUserSettings' - The default settings to use to create a user profile when @UserSettings@
-- isn\'t specified in the call to the @CreateUserProfile@ API.
--
-- @SecurityGroups@ is aggregated when specified in both calls. For all
-- other settings in @UserSettings@, the values specified in
-- @CreateUserProfile@ take precedence over those specified in
-- @CreateDomain@.
--
-- 'subnetIds', 'createDomain_subnetIds' - The VPC subnets that Studio uses for communication.
--
-- 'vpcId', 'createDomain_vpcId' - The ID of the Amazon Virtual Private Cloud (VPC) that Studio uses for
-- communication.
newCreateDomain ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'authMode'
  AuthMode ->
  -- | 'defaultUserSettings'
  UserSettings ->
  -- | 'subnetIds'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'vpcId'
  Prelude.Text ->
  CreateDomain
newCreateDomain :: Text
-> AuthMode
-> UserSettings
-> NonEmpty Text
-> Text
-> CreateDomain
newCreateDomain
  Text
pDomainName_
  AuthMode
pAuthMode_
  UserSettings
pDefaultUserSettings_
  NonEmpty Text
pSubnetIds_
  Text
pVpcId_ =
    CreateDomain'
      { $sel:appNetworkAccessType:CreateDomain' :: Maybe AppNetworkAccessType
appNetworkAccessType =
          forall a. Maybe a
Prelude.Nothing,
        $sel:appSecurityGroupManagement:CreateDomain' :: Maybe AppSecurityGroupManagement
appSecurityGroupManagement = forall a. Maybe a
Prelude.Nothing,
        $sel:defaultSpaceSettings:CreateDomain' :: Maybe DefaultSpaceSettings
defaultSpaceSettings = forall a. Maybe a
Prelude.Nothing,
        $sel:domainSettings:CreateDomain' :: Maybe DomainSettings
domainSettings = forall a. Maybe a
Prelude.Nothing,
        $sel:homeEfsFileSystemKmsKeyId:CreateDomain' :: Maybe Text
homeEfsFileSystemKmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:CreateDomain' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateDomain' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:domainName:CreateDomain' :: Text
domainName = Text
pDomainName_,
        $sel:authMode:CreateDomain' :: AuthMode
authMode = AuthMode
pAuthMode_,
        $sel:defaultUserSettings:CreateDomain' :: UserSettings
defaultUserSettings = UserSettings
pDefaultUserSettings_,
        $sel:subnetIds:CreateDomain' :: NonEmpty Text
subnetIds = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pSubnetIds_,
        $sel:vpcId:CreateDomain' :: Text
vpcId = Text
pVpcId_
      }

-- | Specifies the VPC used for non-EFS traffic. The default value is
-- @PublicInternetOnly@.
--
-- -   @PublicInternetOnly@ - Non-EFS traffic is through a VPC managed by
--     Amazon SageMaker, which allows direct internet access
--
-- -   @VpcOnly@ - All Studio traffic is through the specified VPC and
--     subnets
createDomain_appNetworkAccessType :: Lens.Lens' CreateDomain (Prelude.Maybe AppNetworkAccessType)
createDomain_appNetworkAccessType :: Lens' CreateDomain (Maybe AppNetworkAccessType)
createDomain_appNetworkAccessType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe AppNetworkAccessType
appNetworkAccessType :: Maybe AppNetworkAccessType
$sel:appNetworkAccessType:CreateDomain' :: CreateDomain -> Maybe AppNetworkAccessType
appNetworkAccessType} -> Maybe AppNetworkAccessType
appNetworkAccessType) (\s :: CreateDomain
s@CreateDomain' {} Maybe AppNetworkAccessType
a -> CreateDomain
s {$sel:appNetworkAccessType:CreateDomain' :: Maybe AppNetworkAccessType
appNetworkAccessType = Maybe AppNetworkAccessType
a} :: CreateDomain)

-- | The entity that creates and manages the required security groups for
-- inter-app communication in @VPCOnly@ mode. Required when
-- @CreateDomain.AppNetworkAccessType@ is @VPCOnly@ and
-- @DomainSettings.RStudioServerProDomainSettings.DomainExecutionRoleArn@
-- is provided.
createDomain_appSecurityGroupManagement :: Lens.Lens' CreateDomain (Prelude.Maybe AppSecurityGroupManagement)
createDomain_appSecurityGroupManagement :: Lens' CreateDomain (Maybe AppSecurityGroupManagement)
createDomain_appSecurityGroupManagement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe AppSecurityGroupManagement
appSecurityGroupManagement :: Maybe AppSecurityGroupManagement
$sel:appSecurityGroupManagement:CreateDomain' :: CreateDomain -> Maybe AppSecurityGroupManagement
appSecurityGroupManagement} -> Maybe AppSecurityGroupManagement
appSecurityGroupManagement) (\s :: CreateDomain
s@CreateDomain' {} Maybe AppSecurityGroupManagement
a -> CreateDomain
s {$sel:appSecurityGroupManagement:CreateDomain' :: Maybe AppSecurityGroupManagement
appSecurityGroupManagement = Maybe AppSecurityGroupManagement
a} :: CreateDomain)

-- | The default settings used to create a space.
createDomain_defaultSpaceSettings :: Lens.Lens' CreateDomain (Prelude.Maybe DefaultSpaceSettings)
createDomain_defaultSpaceSettings :: Lens' CreateDomain (Maybe DefaultSpaceSettings)
createDomain_defaultSpaceSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe DefaultSpaceSettings
defaultSpaceSettings :: Maybe DefaultSpaceSettings
$sel:defaultSpaceSettings:CreateDomain' :: CreateDomain -> Maybe DefaultSpaceSettings
defaultSpaceSettings} -> Maybe DefaultSpaceSettings
defaultSpaceSettings) (\s :: CreateDomain
s@CreateDomain' {} Maybe DefaultSpaceSettings
a -> CreateDomain
s {$sel:defaultSpaceSettings:CreateDomain' :: Maybe DefaultSpaceSettings
defaultSpaceSettings = Maybe DefaultSpaceSettings
a} :: CreateDomain)

-- | A collection of @Domain@ settings.
createDomain_domainSettings :: Lens.Lens' CreateDomain (Prelude.Maybe DomainSettings)
createDomain_domainSettings :: Lens' CreateDomain (Maybe DomainSettings)
createDomain_domainSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe DomainSettings
domainSettings :: Maybe DomainSettings
$sel:domainSettings:CreateDomain' :: CreateDomain -> Maybe DomainSettings
domainSettings} -> Maybe DomainSettings
domainSettings) (\s :: CreateDomain
s@CreateDomain' {} Maybe DomainSettings
a -> CreateDomain
s {$sel:domainSettings:CreateDomain' :: Maybe DomainSettings
domainSettings = Maybe DomainSettings
a} :: CreateDomain)

-- | Use @KmsKeyId@.
createDomain_homeEfsFileSystemKmsKeyId :: Lens.Lens' CreateDomain (Prelude.Maybe Prelude.Text)
createDomain_homeEfsFileSystemKmsKeyId :: Lens' CreateDomain (Maybe Text)
createDomain_homeEfsFileSystemKmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe Text
homeEfsFileSystemKmsKeyId :: Maybe Text
$sel:homeEfsFileSystemKmsKeyId:CreateDomain' :: CreateDomain -> Maybe Text
homeEfsFileSystemKmsKeyId} -> Maybe Text
homeEfsFileSystemKmsKeyId) (\s :: CreateDomain
s@CreateDomain' {} Maybe Text
a -> CreateDomain
s {$sel:homeEfsFileSystemKmsKeyId:CreateDomain' :: Maybe Text
homeEfsFileSystemKmsKeyId = Maybe Text
a} :: CreateDomain)

-- | SageMaker uses Amazon Web Services KMS to encrypt the EFS volume
-- attached to the domain with an Amazon Web Services managed key by
-- default. For more control, specify a customer managed key.
createDomain_kmsKeyId :: Lens.Lens' CreateDomain (Prelude.Maybe Prelude.Text)
createDomain_kmsKeyId :: Lens' CreateDomain (Maybe Text)
createDomain_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:CreateDomain' :: CreateDomain -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: CreateDomain
s@CreateDomain' {} Maybe Text
a -> CreateDomain
s {$sel:kmsKeyId:CreateDomain' :: Maybe Text
kmsKeyId = Maybe Text
a} :: CreateDomain)

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

-- | A name for the domain.
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)

-- | The mode of authentication that members use to access the domain.
createDomain_authMode :: Lens.Lens' CreateDomain AuthMode
createDomain_authMode :: Lens' CreateDomain AuthMode
createDomain_authMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {AuthMode
authMode :: AuthMode
$sel:authMode:CreateDomain' :: CreateDomain -> AuthMode
authMode} -> AuthMode
authMode) (\s :: CreateDomain
s@CreateDomain' {} AuthMode
a -> CreateDomain
s {$sel:authMode:CreateDomain' :: AuthMode
authMode = AuthMode
a} :: CreateDomain)

-- | The default settings to use to create a user profile when @UserSettings@
-- isn\'t specified in the call to the @CreateUserProfile@ API.
--
-- @SecurityGroups@ is aggregated when specified in both calls. For all
-- other settings in @UserSettings@, the values specified in
-- @CreateUserProfile@ take precedence over those specified in
-- @CreateDomain@.
createDomain_defaultUserSettings :: Lens.Lens' CreateDomain UserSettings
createDomain_defaultUserSettings :: Lens' CreateDomain UserSettings
createDomain_defaultUserSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {UserSettings
defaultUserSettings :: UserSettings
$sel:defaultUserSettings:CreateDomain' :: CreateDomain -> UserSettings
defaultUserSettings} -> UserSettings
defaultUserSettings) (\s :: CreateDomain
s@CreateDomain' {} UserSettings
a -> CreateDomain
s {$sel:defaultUserSettings:CreateDomain' :: UserSettings
defaultUserSettings = UserSettings
a} :: CreateDomain)

-- | The VPC subnets that Studio uses for communication.
createDomain_subnetIds :: Lens.Lens' CreateDomain (Prelude.NonEmpty Prelude.Text)
createDomain_subnetIds :: Lens' CreateDomain (NonEmpty Text)
createDomain_subnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {NonEmpty Text
subnetIds :: NonEmpty Text
$sel:subnetIds:CreateDomain' :: CreateDomain -> NonEmpty Text
subnetIds} -> NonEmpty Text
subnetIds) (\s :: CreateDomain
s@CreateDomain' {} NonEmpty Text
a -> CreateDomain
s {$sel:subnetIds:CreateDomain' :: NonEmpty Text
subnetIds = NonEmpty Text
a} :: CreateDomain) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The ID of the Amazon Virtual Private Cloud (VPC) that Studio uses for
-- communication.
createDomain_vpcId :: Lens.Lens' CreateDomain Prelude.Text
createDomain_vpcId :: Lens' CreateDomain Text
createDomain_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomain' {Text
vpcId :: Text
$sel:vpcId:CreateDomain' :: CreateDomain -> Text
vpcId} -> Text
vpcId) (\s :: CreateDomain
s@CreateDomain' {} Text
a -> CreateDomain
s {$sel:vpcId:CreateDomain' :: Text
vpcId = 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 Text -> Maybe Text -> 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
"DomainArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Url")
            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 AppNetworkAccessType
Maybe AppSecurityGroupManagement
Maybe DomainSettings
Maybe DefaultSpaceSettings
NonEmpty Text
Text
AuthMode
UserSettings
vpcId :: Text
subnetIds :: NonEmpty Text
defaultUserSettings :: UserSettings
authMode :: AuthMode
domainName :: Text
tags :: Maybe [Tag]
kmsKeyId :: Maybe Text
homeEfsFileSystemKmsKeyId :: Maybe Text
domainSettings :: Maybe DomainSettings
defaultSpaceSettings :: Maybe DefaultSpaceSettings
appSecurityGroupManagement :: Maybe AppSecurityGroupManagement
appNetworkAccessType :: Maybe AppNetworkAccessType
$sel:vpcId:CreateDomain' :: CreateDomain -> Text
$sel:subnetIds:CreateDomain' :: CreateDomain -> NonEmpty Text
$sel:defaultUserSettings:CreateDomain' :: CreateDomain -> UserSettings
$sel:authMode:CreateDomain' :: CreateDomain -> AuthMode
$sel:domainName:CreateDomain' :: CreateDomain -> Text
$sel:tags:CreateDomain' :: CreateDomain -> Maybe [Tag]
$sel:kmsKeyId:CreateDomain' :: CreateDomain -> Maybe Text
$sel:homeEfsFileSystemKmsKeyId:CreateDomain' :: CreateDomain -> Maybe Text
$sel:domainSettings:CreateDomain' :: CreateDomain -> Maybe DomainSettings
$sel:defaultSpaceSettings:CreateDomain' :: CreateDomain -> Maybe DefaultSpaceSettings
$sel:appSecurityGroupManagement:CreateDomain' :: CreateDomain -> Maybe AppSecurityGroupManagement
$sel:appNetworkAccessType:CreateDomain' :: CreateDomain -> Maybe AppNetworkAccessType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AppNetworkAccessType
appNetworkAccessType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AppSecurityGroupManagement
appSecurityGroupManagement
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DefaultSpaceSettings
defaultSpaceSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DomainSettings
domainSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
homeEfsFileSystemKmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AuthMode
authMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UserSettings
defaultUserSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
subnetIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vpcId

instance Prelude.NFData CreateDomain where
  rnf :: CreateDomain -> ()
rnf CreateDomain' {Maybe [Tag]
Maybe Text
Maybe AppNetworkAccessType
Maybe AppSecurityGroupManagement
Maybe DomainSettings
Maybe DefaultSpaceSettings
NonEmpty Text
Text
AuthMode
UserSettings
vpcId :: Text
subnetIds :: NonEmpty Text
defaultUserSettings :: UserSettings
authMode :: AuthMode
domainName :: Text
tags :: Maybe [Tag]
kmsKeyId :: Maybe Text
homeEfsFileSystemKmsKeyId :: Maybe Text
domainSettings :: Maybe DomainSettings
defaultSpaceSettings :: Maybe DefaultSpaceSettings
appSecurityGroupManagement :: Maybe AppSecurityGroupManagement
appNetworkAccessType :: Maybe AppNetworkAccessType
$sel:vpcId:CreateDomain' :: CreateDomain -> Text
$sel:subnetIds:CreateDomain' :: CreateDomain -> NonEmpty Text
$sel:defaultUserSettings:CreateDomain' :: CreateDomain -> UserSettings
$sel:authMode:CreateDomain' :: CreateDomain -> AuthMode
$sel:domainName:CreateDomain' :: CreateDomain -> Text
$sel:tags:CreateDomain' :: CreateDomain -> Maybe [Tag]
$sel:kmsKeyId:CreateDomain' :: CreateDomain -> Maybe Text
$sel:homeEfsFileSystemKmsKeyId:CreateDomain' :: CreateDomain -> Maybe Text
$sel:domainSettings:CreateDomain' :: CreateDomain -> Maybe DomainSettings
$sel:defaultSpaceSettings:CreateDomain' :: CreateDomain -> Maybe DefaultSpaceSettings
$sel:appSecurityGroupManagement:CreateDomain' :: CreateDomain -> Maybe AppSecurityGroupManagement
$sel:appNetworkAccessType:CreateDomain' :: CreateDomain -> Maybe AppNetworkAccessType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AppNetworkAccessType
appNetworkAccessType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AppSecurityGroupManagement
appSecurityGroupManagement
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DefaultSpaceSettings
defaultSpaceSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DomainSettings
domainSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
homeEfsFileSystemKmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      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
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AuthMode
authMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UserSettings
defaultUserSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
subnetIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vpcId

instance Data.ToHeaders CreateDomain where
  toHeaders :: CreateDomain -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"SageMaker.CreateDomain" :: 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 CreateDomain where
  toJSON :: CreateDomain -> Value
toJSON CreateDomain' {Maybe [Tag]
Maybe Text
Maybe AppNetworkAccessType
Maybe AppSecurityGroupManagement
Maybe DomainSettings
Maybe DefaultSpaceSettings
NonEmpty Text
Text
AuthMode
UserSettings
vpcId :: Text
subnetIds :: NonEmpty Text
defaultUserSettings :: UserSettings
authMode :: AuthMode
domainName :: Text
tags :: Maybe [Tag]
kmsKeyId :: Maybe Text
homeEfsFileSystemKmsKeyId :: Maybe Text
domainSettings :: Maybe DomainSettings
defaultSpaceSettings :: Maybe DefaultSpaceSettings
appSecurityGroupManagement :: Maybe AppSecurityGroupManagement
appNetworkAccessType :: Maybe AppNetworkAccessType
$sel:vpcId:CreateDomain' :: CreateDomain -> Text
$sel:subnetIds:CreateDomain' :: CreateDomain -> NonEmpty Text
$sel:defaultUserSettings:CreateDomain' :: CreateDomain -> UserSettings
$sel:authMode:CreateDomain' :: CreateDomain -> AuthMode
$sel:domainName:CreateDomain' :: CreateDomain -> Text
$sel:tags:CreateDomain' :: CreateDomain -> Maybe [Tag]
$sel:kmsKeyId:CreateDomain' :: CreateDomain -> Maybe Text
$sel:homeEfsFileSystemKmsKeyId:CreateDomain' :: CreateDomain -> Maybe Text
$sel:domainSettings:CreateDomain' :: CreateDomain -> Maybe DomainSettings
$sel:defaultSpaceSettings:CreateDomain' :: CreateDomain -> Maybe DefaultSpaceSettings
$sel:appSecurityGroupManagement:CreateDomain' :: CreateDomain -> Maybe AppSecurityGroupManagement
$sel:appNetworkAccessType:CreateDomain' :: CreateDomain -> Maybe AppNetworkAccessType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AppNetworkAccessType" 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 AppNetworkAccessType
appNetworkAccessType,
            (Key
"AppSecurityGroupManagement" 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 AppSecurityGroupManagement
appSecurityGroupManagement,
            (Key
"DefaultSpaceSettings" 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 DefaultSpaceSettings
defaultSpaceSettings,
            (Key
"DomainSettings" 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 DomainSettings
domainSettings,
            (Key
"HomeEfsFileSystemKmsKeyId" 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
homeEfsFileSystemKmsKeyId,
            (Key
"KmsKeyId" 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
kmsKeyId,
            (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
"DomainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainName),
            forall a. a -> Maybe a
Prelude.Just (Key
"AuthMode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AuthMode
authMode),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DefaultUserSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= UserSettings
defaultUserSettings),
            forall a. a -> Maybe a
Prelude.Just (Key
"SubnetIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
subnetIds),
            forall a. a -> Maybe a
Prelude.Just (Key
"VpcId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
vpcId)
          ]
      )

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

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

-- | /See:/ 'newCreateDomainResponse' smart constructor.
data CreateDomainResponse = CreateDomainResponse'
  { -- | The Amazon Resource Name (ARN) of the created domain.
    CreateDomainResponse -> Maybe Text
domainArn :: Prelude.Maybe Prelude.Text,
    -- | The URL to the created domain.
    CreateDomainResponse -> Maybe Text
url :: Prelude.Maybe Prelude.Text,
    -- | 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:
--
-- 'domainArn', 'createDomainResponse_domainArn' - The Amazon Resource Name (ARN) of the created domain.
--
-- 'url', 'createDomainResponse_url' - The URL to the created domain.
--
-- 'httpStatus', 'createDomainResponse_httpStatus' - The response's http status code.
newCreateDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDomainResponse
newCreateDomainResponse :: Int -> CreateDomainResponse
newCreateDomainResponse Int
pHttpStatus_ =
  CreateDomainResponse'
    { $sel:domainArn:CreateDomainResponse' :: Maybe Text
domainArn = forall a. Maybe a
Prelude.Nothing,
      $sel:url:CreateDomainResponse' :: Maybe Text
url = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDomainResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the created domain.
createDomainResponse_domainArn :: Lens.Lens' CreateDomainResponse (Prelude.Maybe Prelude.Text)
createDomainResponse_domainArn :: Lens' CreateDomainResponse (Maybe Text)
createDomainResponse_domainArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainResponse' {Maybe Text
domainArn :: Maybe Text
$sel:domainArn:CreateDomainResponse' :: CreateDomainResponse -> Maybe Text
domainArn} -> Maybe Text
domainArn) (\s :: CreateDomainResponse
s@CreateDomainResponse' {} Maybe Text
a -> CreateDomainResponse
s {$sel:domainArn:CreateDomainResponse' :: Maybe Text
domainArn = Maybe Text
a} :: CreateDomainResponse)

-- | The URL to the created domain.
createDomainResponse_url :: Lens.Lens' CreateDomainResponse (Prelude.Maybe Prelude.Text)
createDomainResponse_url :: Lens' CreateDomainResponse (Maybe Text)
createDomainResponse_url = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainResponse' {Maybe Text
url :: Maybe Text
$sel:url:CreateDomainResponse' :: CreateDomainResponse -> Maybe Text
url} -> Maybe Text
url) (\s :: CreateDomainResponse
s@CreateDomainResponse' {} Maybe Text
a -> CreateDomainResponse
s {$sel:url:CreateDomainResponse' :: Maybe Text
url = Maybe Text
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 Text
httpStatus :: Int
url :: Maybe Text
domainArn :: Maybe Text
$sel:httpStatus:CreateDomainResponse' :: CreateDomainResponse -> Int
$sel:url:CreateDomainResponse' :: CreateDomainResponse -> Maybe Text
$sel:domainArn:CreateDomainResponse' :: CreateDomainResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
url
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus