{-# 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.UpdateDomain
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the default settings for new user profiles in the domain.
module Amazonka.SageMaker.UpdateDomain
  ( -- * Creating a Request
    UpdateDomain (..),
    newUpdateDomain,

    -- * Request Lenses
    updateDomain_appSecurityGroupManagement,
    updateDomain_defaultSpaceSettings,
    updateDomain_defaultUserSettings,
    updateDomain_domainSettingsForUpdate,
    updateDomain_domainId,

    -- * Destructuring the Response
    UpdateDomainResponse (..),
    newUpdateDomainResponse,

    -- * Response Lenses
    updateDomainResponse_domainArn,
    updateDomainResponse_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:/ 'newUpdateDomain' smart constructor.
data UpdateDomain = UpdateDomain'
  { -- | 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.
    UpdateDomain -> Maybe AppSecurityGroupManagement
appSecurityGroupManagement :: Prelude.Maybe AppSecurityGroupManagement,
    -- | The default settings used to create a space within the Domain.
    UpdateDomain -> Maybe DefaultSpaceSettings
defaultSpaceSettings :: Prelude.Maybe DefaultSpaceSettings,
    -- | A collection of settings.
    UpdateDomain -> Maybe UserSettings
defaultUserSettings :: Prelude.Maybe UserSettings,
    -- | A collection of @DomainSettings@ configuration values to update.
    UpdateDomain -> Maybe DomainSettingsForUpdate
domainSettingsForUpdate :: Prelude.Maybe DomainSettingsForUpdate,
    -- | The ID of the domain to be updated.
    UpdateDomain -> Text
domainId :: Prelude.Text
  }
  deriving (UpdateDomain -> UpdateDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDomain -> UpdateDomain -> Bool
$c/= :: UpdateDomain -> UpdateDomain -> Bool
== :: UpdateDomain -> UpdateDomain -> Bool
$c== :: UpdateDomain -> UpdateDomain -> Bool
Prelude.Eq, ReadPrec [UpdateDomain]
ReadPrec UpdateDomain
Int -> ReadS UpdateDomain
ReadS [UpdateDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDomain]
$creadListPrec :: ReadPrec [UpdateDomain]
readPrec :: ReadPrec UpdateDomain
$creadPrec :: ReadPrec UpdateDomain
readList :: ReadS [UpdateDomain]
$creadList :: ReadS [UpdateDomain]
readsPrec :: Int -> ReadS UpdateDomain
$creadsPrec :: Int -> ReadS UpdateDomain
Prelude.Read, Int -> UpdateDomain -> ShowS
[UpdateDomain] -> ShowS
UpdateDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDomain] -> ShowS
$cshowList :: [UpdateDomain] -> ShowS
show :: UpdateDomain -> String
$cshow :: UpdateDomain -> String
showsPrec :: Int -> UpdateDomain -> ShowS
$cshowsPrec :: Int -> UpdateDomain -> ShowS
Prelude.Show, forall x. Rep UpdateDomain x -> UpdateDomain
forall x. UpdateDomain -> Rep UpdateDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDomain x -> UpdateDomain
$cfrom :: forall x. UpdateDomain -> Rep UpdateDomain x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDomain' 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:
--
-- 'appSecurityGroupManagement', 'updateDomain_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', 'updateDomain_defaultSpaceSettings' - The default settings used to create a space within the Domain.
--
-- 'defaultUserSettings', 'updateDomain_defaultUserSettings' - A collection of settings.
--
-- 'domainSettingsForUpdate', 'updateDomain_domainSettingsForUpdate' - A collection of @DomainSettings@ configuration values to update.
--
-- 'domainId', 'updateDomain_domainId' - The ID of the domain to be updated.
newUpdateDomain ::
  -- | 'domainId'
  Prelude.Text ->
  UpdateDomain
newUpdateDomain :: Text -> UpdateDomain
newUpdateDomain Text
pDomainId_ =
  UpdateDomain'
    { $sel:appSecurityGroupManagement:UpdateDomain' :: Maybe AppSecurityGroupManagement
appSecurityGroupManagement =
        forall a. Maybe a
Prelude.Nothing,
      $sel:defaultSpaceSettings:UpdateDomain' :: Maybe DefaultSpaceSettings
defaultSpaceSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultUserSettings:UpdateDomain' :: Maybe UserSettings
defaultUserSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:domainSettingsForUpdate:UpdateDomain' :: Maybe DomainSettingsForUpdate
domainSettingsForUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:domainId:UpdateDomain' :: Text
domainId = Text
pDomainId_
    }

-- | 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.
updateDomain_appSecurityGroupManagement :: Lens.Lens' UpdateDomain (Prelude.Maybe AppSecurityGroupManagement)
updateDomain_appSecurityGroupManagement :: Lens' UpdateDomain (Maybe AppSecurityGroupManagement)
updateDomain_appSecurityGroupManagement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomain' {Maybe AppSecurityGroupManagement
appSecurityGroupManagement :: Maybe AppSecurityGroupManagement
$sel:appSecurityGroupManagement:UpdateDomain' :: UpdateDomain -> Maybe AppSecurityGroupManagement
appSecurityGroupManagement} -> Maybe AppSecurityGroupManagement
appSecurityGroupManagement) (\s :: UpdateDomain
s@UpdateDomain' {} Maybe AppSecurityGroupManagement
a -> UpdateDomain
s {$sel:appSecurityGroupManagement:UpdateDomain' :: Maybe AppSecurityGroupManagement
appSecurityGroupManagement = Maybe AppSecurityGroupManagement
a} :: UpdateDomain)

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

-- | A collection of settings.
updateDomain_defaultUserSettings :: Lens.Lens' UpdateDomain (Prelude.Maybe UserSettings)
updateDomain_defaultUserSettings :: Lens' UpdateDomain (Maybe UserSettings)
updateDomain_defaultUserSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomain' {Maybe UserSettings
defaultUserSettings :: Maybe UserSettings
$sel:defaultUserSettings:UpdateDomain' :: UpdateDomain -> Maybe UserSettings
defaultUserSettings} -> Maybe UserSettings
defaultUserSettings) (\s :: UpdateDomain
s@UpdateDomain' {} Maybe UserSettings
a -> UpdateDomain
s {$sel:defaultUserSettings:UpdateDomain' :: Maybe UserSettings
defaultUserSettings = Maybe UserSettings
a} :: UpdateDomain)

-- | A collection of @DomainSettings@ configuration values to update.
updateDomain_domainSettingsForUpdate :: Lens.Lens' UpdateDomain (Prelude.Maybe DomainSettingsForUpdate)
updateDomain_domainSettingsForUpdate :: Lens' UpdateDomain (Maybe DomainSettingsForUpdate)
updateDomain_domainSettingsForUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomain' {Maybe DomainSettingsForUpdate
domainSettingsForUpdate :: Maybe DomainSettingsForUpdate
$sel:domainSettingsForUpdate:UpdateDomain' :: UpdateDomain -> Maybe DomainSettingsForUpdate
domainSettingsForUpdate} -> Maybe DomainSettingsForUpdate
domainSettingsForUpdate) (\s :: UpdateDomain
s@UpdateDomain' {} Maybe DomainSettingsForUpdate
a -> UpdateDomain
s {$sel:domainSettingsForUpdate:UpdateDomain' :: Maybe DomainSettingsForUpdate
domainSettingsForUpdate = Maybe DomainSettingsForUpdate
a} :: UpdateDomain)

-- | The ID of the domain to be updated.
updateDomain_domainId :: Lens.Lens' UpdateDomain Prelude.Text
updateDomain_domainId :: Lens' UpdateDomain Text
updateDomain_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomain' {Text
domainId :: Text
$sel:domainId:UpdateDomain' :: UpdateDomain -> Text
domainId} -> Text
domainId) (\s :: UpdateDomain
s@UpdateDomain' {} Text
a -> UpdateDomain
s {$sel:domainId:UpdateDomain' :: Text
domainId = Text
a} :: UpdateDomain)

instance Core.AWSRequest UpdateDomain where
  type AWSResponse UpdateDomain = UpdateDomainResponse
  request :: (Service -> Service) -> UpdateDomain -> Request UpdateDomain
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 UpdateDomain
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateDomain)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> UpdateDomainResponse
UpdateDomainResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateDomain where
  hashWithSalt :: Int -> UpdateDomain -> Int
hashWithSalt Int
_salt UpdateDomain' {Maybe AppSecurityGroupManagement
Maybe DomainSettingsForUpdate
Maybe DefaultSpaceSettings
Maybe UserSettings
Text
domainId :: Text
domainSettingsForUpdate :: Maybe DomainSettingsForUpdate
defaultUserSettings :: Maybe UserSettings
defaultSpaceSettings :: Maybe DefaultSpaceSettings
appSecurityGroupManagement :: Maybe AppSecurityGroupManagement
$sel:domainId:UpdateDomain' :: UpdateDomain -> Text
$sel:domainSettingsForUpdate:UpdateDomain' :: UpdateDomain -> Maybe DomainSettingsForUpdate
$sel:defaultUserSettings:UpdateDomain' :: UpdateDomain -> Maybe UserSettings
$sel:defaultSpaceSettings:UpdateDomain' :: UpdateDomain -> Maybe DefaultSpaceSettings
$sel:appSecurityGroupManagement:UpdateDomain' :: UpdateDomain -> Maybe AppSecurityGroupManagement
..} =
    Int
_salt
      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 UserSettings
defaultUserSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DomainSettingsForUpdate
domainSettingsForUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainId

instance Prelude.NFData UpdateDomain where
  rnf :: UpdateDomain -> ()
rnf UpdateDomain' {Maybe AppSecurityGroupManagement
Maybe DomainSettingsForUpdate
Maybe DefaultSpaceSettings
Maybe UserSettings
Text
domainId :: Text
domainSettingsForUpdate :: Maybe DomainSettingsForUpdate
defaultUserSettings :: Maybe UserSettings
defaultSpaceSettings :: Maybe DefaultSpaceSettings
appSecurityGroupManagement :: Maybe AppSecurityGroupManagement
$sel:domainId:UpdateDomain' :: UpdateDomain -> Text
$sel:domainSettingsForUpdate:UpdateDomain' :: UpdateDomain -> Maybe DomainSettingsForUpdate
$sel:defaultUserSettings:UpdateDomain' :: UpdateDomain -> Maybe UserSettings
$sel:defaultSpaceSettings:UpdateDomain' :: UpdateDomain -> Maybe DefaultSpaceSettings
$sel:appSecurityGroupManagement:UpdateDomain' :: UpdateDomain -> Maybe AppSecurityGroupManagement
..} =
    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 UserSettings
defaultUserSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DomainSettingsForUpdate
domainSettingsForUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainId

instance Data.ToHeaders UpdateDomain where
  toHeaders :: UpdateDomain -> 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.UpdateDomain" :: 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 UpdateDomain where
  toJSON :: UpdateDomain -> Value
toJSON UpdateDomain' {Maybe AppSecurityGroupManagement
Maybe DomainSettingsForUpdate
Maybe DefaultSpaceSettings
Maybe UserSettings
Text
domainId :: Text
domainSettingsForUpdate :: Maybe DomainSettingsForUpdate
defaultUserSettings :: Maybe UserSettings
defaultSpaceSettings :: Maybe DefaultSpaceSettings
appSecurityGroupManagement :: Maybe AppSecurityGroupManagement
$sel:domainId:UpdateDomain' :: UpdateDomain -> Text
$sel:domainSettingsForUpdate:UpdateDomain' :: UpdateDomain -> Maybe DomainSettingsForUpdate
$sel:defaultUserSettings:UpdateDomain' :: UpdateDomain -> Maybe UserSettings
$sel:defaultSpaceSettings:UpdateDomain' :: UpdateDomain -> Maybe DefaultSpaceSettings
$sel:appSecurityGroupManagement:UpdateDomain' :: UpdateDomain -> Maybe AppSecurityGroupManagement
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"DefaultUserSettings" 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 UserSettings
defaultUserSettings,
            (Key
"DomainSettingsForUpdate" 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 DomainSettingsForUpdate
domainSettingsForUpdate,
            forall a. a -> Maybe a
Prelude.Just (Key
"DomainId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainId)
          ]
      )

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

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

-- | /See:/ 'newUpdateDomainResponse' smart constructor.
data UpdateDomainResponse = UpdateDomainResponse'
  { -- | The Amazon Resource Name (ARN) of the domain.
    UpdateDomainResponse -> Maybe Text
domainArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateDomainResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateDomainResponse -> UpdateDomainResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDomainResponse -> UpdateDomainResponse -> Bool
$c/= :: UpdateDomainResponse -> UpdateDomainResponse -> Bool
== :: UpdateDomainResponse -> UpdateDomainResponse -> Bool
$c== :: UpdateDomainResponse -> UpdateDomainResponse -> Bool
Prelude.Eq, ReadPrec [UpdateDomainResponse]
ReadPrec UpdateDomainResponse
Int -> ReadS UpdateDomainResponse
ReadS [UpdateDomainResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDomainResponse]
$creadListPrec :: ReadPrec [UpdateDomainResponse]
readPrec :: ReadPrec UpdateDomainResponse
$creadPrec :: ReadPrec UpdateDomainResponse
readList :: ReadS [UpdateDomainResponse]
$creadList :: ReadS [UpdateDomainResponse]
readsPrec :: Int -> ReadS UpdateDomainResponse
$creadsPrec :: Int -> ReadS UpdateDomainResponse
Prelude.Read, Int -> UpdateDomainResponse -> ShowS
[UpdateDomainResponse] -> ShowS
UpdateDomainResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDomainResponse] -> ShowS
$cshowList :: [UpdateDomainResponse] -> ShowS
show :: UpdateDomainResponse -> String
$cshow :: UpdateDomainResponse -> String
showsPrec :: Int -> UpdateDomainResponse -> ShowS
$cshowsPrec :: Int -> UpdateDomainResponse -> ShowS
Prelude.Show, forall x. Rep UpdateDomainResponse x -> UpdateDomainResponse
forall x. UpdateDomainResponse -> Rep UpdateDomainResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDomainResponse x -> UpdateDomainResponse
$cfrom :: forall x. UpdateDomainResponse -> Rep UpdateDomainResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDomainResponse' 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', 'updateDomainResponse_domainArn' - The Amazon Resource Name (ARN) of the domain.
--
-- 'httpStatus', 'updateDomainResponse_httpStatus' - The response's http status code.
newUpdateDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDomainResponse
newUpdateDomainResponse :: Int -> UpdateDomainResponse
newUpdateDomainResponse Int
pHttpStatus_ =
  UpdateDomainResponse'
    { $sel:domainArn:UpdateDomainResponse' :: Maybe Text
domainArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateDomainResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance Prelude.NFData UpdateDomainResponse where
  rnf :: UpdateDomainResponse -> ()
rnf UpdateDomainResponse' {Int
Maybe Text
httpStatus :: Int
domainArn :: Maybe Text
$sel:httpStatus:UpdateDomainResponse' :: UpdateDomainResponse -> Int
$sel:domainArn:UpdateDomainResponse' :: UpdateDomainResponse -> 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 Int
httpStatus