{-# 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.IoT.UpdateDomainConfiguration
-- 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 values stored in the domain configuration. Domain configurations
-- for default endpoints can\'t be updated.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions UpdateDomainConfiguration>
-- action.
module Amazonka.IoT.UpdateDomainConfiguration
  ( -- * Creating a Request
    UpdateDomainConfiguration (..),
    newUpdateDomainConfiguration,

    -- * Request Lenses
    updateDomainConfiguration_authorizerConfig,
    updateDomainConfiguration_domainConfigurationStatus,
    updateDomainConfiguration_removeAuthorizerConfig,
    updateDomainConfiguration_domainConfigurationName,

    -- * Destructuring the Response
    UpdateDomainConfigurationResponse (..),
    newUpdateDomainConfigurationResponse,

    -- * Response Lenses
    updateDomainConfigurationResponse_domainConfigurationArn,
    updateDomainConfigurationResponse_domainConfigurationName,
    updateDomainConfigurationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateDomainConfiguration' smart constructor.
data UpdateDomainConfiguration = UpdateDomainConfiguration'
  { -- | An object that specifies the authorization service for a domain.
    UpdateDomainConfiguration -> Maybe AuthorizerConfig
authorizerConfig :: Prelude.Maybe AuthorizerConfig,
    -- | The status to which the domain configuration should be updated.
    UpdateDomainConfiguration -> Maybe DomainConfigurationStatus
domainConfigurationStatus :: Prelude.Maybe DomainConfigurationStatus,
    -- | Removes the authorization configuration from a domain.
    UpdateDomainConfiguration -> Maybe Bool
removeAuthorizerConfig :: Prelude.Maybe Prelude.Bool,
    -- | The name of the domain configuration to be updated.
    UpdateDomainConfiguration -> Text
domainConfigurationName :: Prelude.Text
  }
  deriving (UpdateDomainConfiguration -> UpdateDomainConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDomainConfiguration -> UpdateDomainConfiguration -> Bool
$c/= :: UpdateDomainConfiguration -> UpdateDomainConfiguration -> Bool
== :: UpdateDomainConfiguration -> UpdateDomainConfiguration -> Bool
$c== :: UpdateDomainConfiguration -> UpdateDomainConfiguration -> Bool
Prelude.Eq, ReadPrec [UpdateDomainConfiguration]
ReadPrec UpdateDomainConfiguration
Int -> ReadS UpdateDomainConfiguration
ReadS [UpdateDomainConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDomainConfiguration]
$creadListPrec :: ReadPrec [UpdateDomainConfiguration]
readPrec :: ReadPrec UpdateDomainConfiguration
$creadPrec :: ReadPrec UpdateDomainConfiguration
readList :: ReadS [UpdateDomainConfiguration]
$creadList :: ReadS [UpdateDomainConfiguration]
readsPrec :: Int -> ReadS UpdateDomainConfiguration
$creadsPrec :: Int -> ReadS UpdateDomainConfiguration
Prelude.Read, Int -> UpdateDomainConfiguration -> ShowS
[UpdateDomainConfiguration] -> ShowS
UpdateDomainConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDomainConfiguration] -> ShowS
$cshowList :: [UpdateDomainConfiguration] -> ShowS
show :: UpdateDomainConfiguration -> String
$cshow :: UpdateDomainConfiguration -> String
showsPrec :: Int -> UpdateDomainConfiguration -> ShowS
$cshowsPrec :: Int -> UpdateDomainConfiguration -> ShowS
Prelude.Show, forall x.
Rep UpdateDomainConfiguration x -> UpdateDomainConfiguration
forall x.
UpdateDomainConfiguration -> Rep UpdateDomainConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateDomainConfiguration x -> UpdateDomainConfiguration
$cfrom :: forall x.
UpdateDomainConfiguration -> Rep UpdateDomainConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDomainConfiguration' 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:
--
-- 'authorizerConfig', 'updateDomainConfiguration_authorizerConfig' - An object that specifies the authorization service for a domain.
--
-- 'domainConfigurationStatus', 'updateDomainConfiguration_domainConfigurationStatus' - The status to which the domain configuration should be updated.
--
-- 'removeAuthorizerConfig', 'updateDomainConfiguration_removeAuthorizerConfig' - Removes the authorization configuration from a domain.
--
-- 'domainConfigurationName', 'updateDomainConfiguration_domainConfigurationName' - The name of the domain configuration to be updated.
newUpdateDomainConfiguration ::
  -- | 'domainConfigurationName'
  Prelude.Text ->
  UpdateDomainConfiguration
newUpdateDomainConfiguration :: Text -> UpdateDomainConfiguration
newUpdateDomainConfiguration
  Text
pDomainConfigurationName_ =
    UpdateDomainConfiguration'
      { $sel:authorizerConfig:UpdateDomainConfiguration' :: Maybe AuthorizerConfig
authorizerConfig =
          forall a. Maybe a
Prelude.Nothing,
        $sel:domainConfigurationStatus:UpdateDomainConfiguration' :: Maybe DomainConfigurationStatus
domainConfigurationStatus = forall a. Maybe a
Prelude.Nothing,
        $sel:removeAuthorizerConfig:UpdateDomainConfiguration' :: Maybe Bool
removeAuthorizerConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:domainConfigurationName:UpdateDomainConfiguration' :: Text
domainConfigurationName =
          Text
pDomainConfigurationName_
      }

-- | An object that specifies the authorization service for a domain.
updateDomainConfiguration_authorizerConfig :: Lens.Lens' UpdateDomainConfiguration (Prelude.Maybe AuthorizerConfig)
updateDomainConfiguration_authorizerConfig :: Lens' UpdateDomainConfiguration (Maybe AuthorizerConfig)
updateDomainConfiguration_authorizerConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomainConfiguration' {Maybe AuthorizerConfig
authorizerConfig :: Maybe AuthorizerConfig
$sel:authorizerConfig:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe AuthorizerConfig
authorizerConfig} -> Maybe AuthorizerConfig
authorizerConfig) (\s :: UpdateDomainConfiguration
s@UpdateDomainConfiguration' {} Maybe AuthorizerConfig
a -> UpdateDomainConfiguration
s {$sel:authorizerConfig:UpdateDomainConfiguration' :: Maybe AuthorizerConfig
authorizerConfig = Maybe AuthorizerConfig
a} :: UpdateDomainConfiguration)

-- | The status to which the domain configuration should be updated.
updateDomainConfiguration_domainConfigurationStatus :: Lens.Lens' UpdateDomainConfiguration (Prelude.Maybe DomainConfigurationStatus)
updateDomainConfiguration_domainConfigurationStatus :: Lens' UpdateDomainConfiguration (Maybe DomainConfigurationStatus)
updateDomainConfiguration_domainConfigurationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomainConfiguration' {Maybe DomainConfigurationStatus
domainConfigurationStatus :: Maybe DomainConfigurationStatus
$sel:domainConfigurationStatus:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe DomainConfigurationStatus
domainConfigurationStatus} -> Maybe DomainConfigurationStatus
domainConfigurationStatus) (\s :: UpdateDomainConfiguration
s@UpdateDomainConfiguration' {} Maybe DomainConfigurationStatus
a -> UpdateDomainConfiguration
s {$sel:domainConfigurationStatus:UpdateDomainConfiguration' :: Maybe DomainConfigurationStatus
domainConfigurationStatus = Maybe DomainConfigurationStatus
a} :: UpdateDomainConfiguration)

-- | Removes the authorization configuration from a domain.
updateDomainConfiguration_removeAuthorizerConfig :: Lens.Lens' UpdateDomainConfiguration (Prelude.Maybe Prelude.Bool)
updateDomainConfiguration_removeAuthorizerConfig :: Lens' UpdateDomainConfiguration (Maybe Bool)
updateDomainConfiguration_removeAuthorizerConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomainConfiguration' {Maybe Bool
removeAuthorizerConfig :: Maybe Bool
$sel:removeAuthorizerConfig:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe Bool
removeAuthorizerConfig} -> Maybe Bool
removeAuthorizerConfig) (\s :: UpdateDomainConfiguration
s@UpdateDomainConfiguration' {} Maybe Bool
a -> UpdateDomainConfiguration
s {$sel:removeAuthorizerConfig:UpdateDomainConfiguration' :: Maybe Bool
removeAuthorizerConfig = Maybe Bool
a} :: UpdateDomainConfiguration)

-- | The name of the domain configuration to be updated.
updateDomainConfiguration_domainConfigurationName :: Lens.Lens' UpdateDomainConfiguration Prelude.Text
updateDomainConfiguration_domainConfigurationName :: Lens' UpdateDomainConfiguration Text
updateDomainConfiguration_domainConfigurationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomainConfiguration' {Text
domainConfigurationName :: Text
$sel:domainConfigurationName:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Text
domainConfigurationName} -> Text
domainConfigurationName) (\s :: UpdateDomainConfiguration
s@UpdateDomainConfiguration' {} Text
a -> UpdateDomainConfiguration
s {$sel:domainConfigurationName:UpdateDomainConfiguration' :: Text
domainConfigurationName = Text
a} :: UpdateDomainConfiguration)

instance Core.AWSRequest UpdateDomainConfiguration where
  type
    AWSResponse UpdateDomainConfiguration =
      UpdateDomainConfigurationResponse
  request :: (Service -> Service)
-> UpdateDomainConfiguration -> Request UpdateDomainConfiguration
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateDomainConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateDomainConfiguration)))
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 -> UpdateDomainConfigurationResponse
UpdateDomainConfigurationResponse'
            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
"domainConfigurationArn")
            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
"domainConfigurationName")
            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 UpdateDomainConfiguration where
  hashWithSalt :: Int -> UpdateDomainConfiguration -> Int
hashWithSalt Int
_salt UpdateDomainConfiguration' {Maybe Bool
Maybe AuthorizerConfig
Maybe DomainConfigurationStatus
Text
domainConfigurationName :: Text
removeAuthorizerConfig :: Maybe Bool
domainConfigurationStatus :: Maybe DomainConfigurationStatus
authorizerConfig :: Maybe AuthorizerConfig
$sel:domainConfigurationName:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Text
$sel:removeAuthorizerConfig:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe Bool
$sel:domainConfigurationStatus:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe DomainConfigurationStatus
$sel:authorizerConfig:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe AuthorizerConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AuthorizerConfig
authorizerConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DomainConfigurationStatus
domainConfigurationStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
removeAuthorizerConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainConfigurationName

instance Prelude.NFData UpdateDomainConfiguration where
  rnf :: UpdateDomainConfiguration -> ()
rnf UpdateDomainConfiguration' {Maybe Bool
Maybe AuthorizerConfig
Maybe DomainConfigurationStatus
Text
domainConfigurationName :: Text
removeAuthorizerConfig :: Maybe Bool
domainConfigurationStatus :: Maybe DomainConfigurationStatus
authorizerConfig :: Maybe AuthorizerConfig
$sel:domainConfigurationName:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Text
$sel:removeAuthorizerConfig:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe Bool
$sel:domainConfigurationStatus:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe DomainConfigurationStatus
$sel:authorizerConfig:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe AuthorizerConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AuthorizerConfig
authorizerConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DomainConfigurationStatus
domainConfigurationStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
removeAuthorizerConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainConfigurationName

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

instance Data.ToJSON UpdateDomainConfiguration where
  toJSON :: UpdateDomainConfiguration -> Value
toJSON UpdateDomainConfiguration' {Maybe Bool
Maybe AuthorizerConfig
Maybe DomainConfigurationStatus
Text
domainConfigurationName :: Text
removeAuthorizerConfig :: Maybe Bool
domainConfigurationStatus :: Maybe DomainConfigurationStatus
authorizerConfig :: Maybe AuthorizerConfig
$sel:domainConfigurationName:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Text
$sel:removeAuthorizerConfig:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe Bool
$sel:domainConfigurationStatus:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe DomainConfigurationStatus
$sel:authorizerConfig:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe AuthorizerConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"authorizerConfig" 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 AuthorizerConfig
authorizerConfig,
            (Key
"domainConfigurationStatus" 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 DomainConfigurationStatus
domainConfigurationStatus,
            (Key
"removeAuthorizerConfig" 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 Bool
removeAuthorizerConfig
          ]
      )

instance Data.ToPath UpdateDomainConfiguration where
  toPath :: UpdateDomainConfiguration -> ByteString
toPath UpdateDomainConfiguration' {Maybe Bool
Maybe AuthorizerConfig
Maybe DomainConfigurationStatus
Text
domainConfigurationName :: Text
removeAuthorizerConfig :: Maybe Bool
domainConfigurationStatus :: Maybe DomainConfigurationStatus
authorizerConfig :: Maybe AuthorizerConfig
$sel:domainConfigurationName:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Text
$sel:removeAuthorizerConfig:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe Bool
$sel:domainConfigurationStatus:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe DomainConfigurationStatus
$sel:authorizerConfig:UpdateDomainConfiguration' :: UpdateDomainConfiguration -> Maybe AuthorizerConfig
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domainConfigurations/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainConfigurationName
      ]

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

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

-- |
-- Create a value of 'UpdateDomainConfigurationResponse' 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:
--
-- 'domainConfigurationArn', 'updateDomainConfigurationResponse_domainConfigurationArn' - The ARN of the domain configuration that was updated.
--
-- 'domainConfigurationName', 'updateDomainConfigurationResponse_domainConfigurationName' - The name of the domain configuration that was updated.
--
-- 'httpStatus', 'updateDomainConfigurationResponse_httpStatus' - The response's http status code.
newUpdateDomainConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDomainConfigurationResponse
newUpdateDomainConfigurationResponse :: Int -> UpdateDomainConfigurationResponse
newUpdateDomainConfigurationResponse Int
pHttpStatus_ =
  UpdateDomainConfigurationResponse'
    { $sel:domainConfigurationArn:UpdateDomainConfigurationResponse' :: Maybe Text
domainConfigurationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:domainConfigurationName:UpdateDomainConfigurationResponse' :: Maybe Text
domainConfigurationName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateDomainConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the domain configuration that was updated.
updateDomainConfigurationResponse_domainConfigurationArn :: Lens.Lens' UpdateDomainConfigurationResponse (Prelude.Maybe Prelude.Text)
updateDomainConfigurationResponse_domainConfigurationArn :: Lens' UpdateDomainConfigurationResponse (Maybe Text)
updateDomainConfigurationResponse_domainConfigurationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomainConfigurationResponse' {Maybe Text
domainConfigurationArn :: Maybe Text
$sel:domainConfigurationArn:UpdateDomainConfigurationResponse' :: UpdateDomainConfigurationResponse -> Maybe Text
domainConfigurationArn} -> Maybe Text
domainConfigurationArn) (\s :: UpdateDomainConfigurationResponse
s@UpdateDomainConfigurationResponse' {} Maybe Text
a -> UpdateDomainConfigurationResponse
s {$sel:domainConfigurationArn:UpdateDomainConfigurationResponse' :: Maybe Text
domainConfigurationArn = Maybe Text
a} :: UpdateDomainConfigurationResponse)

-- | The name of the domain configuration that was updated.
updateDomainConfigurationResponse_domainConfigurationName :: Lens.Lens' UpdateDomainConfigurationResponse (Prelude.Maybe Prelude.Text)
updateDomainConfigurationResponse_domainConfigurationName :: Lens' UpdateDomainConfigurationResponse (Maybe Text)
updateDomainConfigurationResponse_domainConfigurationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomainConfigurationResponse' {Maybe Text
domainConfigurationName :: Maybe Text
$sel:domainConfigurationName:UpdateDomainConfigurationResponse' :: UpdateDomainConfigurationResponse -> Maybe Text
domainConfigurationName} -> Maybe Text
domainConfigurationName) (\s :: UpdateDomainConfigurationResponse
s@UpdateDomainConfigurationResponse' {} Maybe Text
a -> UpdateDomainConfigurationResponse
s {$sel:domainConfigurationName:UpdateDomainConfigurationResponse' :: Maybe Text
domainConfigurationName = Maybe Text
a} :: UpdateDomainConfigurationResponse)

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

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