{-# 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.QuickSight.UpdateAccountSettings
-- 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 Amazon QuickSight settings in your Amazon Web Services
-- account.
module Amazonka.QuickSight.UpdateAccountSettings
  ( -- * Creating a Request
    UpdateAccountSettings (..),
    newUpdateAccountSettings,

    -- * Request Lenses
    updateAccountSettings_notificationEmail,
    updateAccountSettings_terminationProtectionEnabled,
    updateAccountSettings_awsAccountId,
    updateAccountSettings_defaultNamespace,

    -- * Destructuring the Response
    UpdateAccountSettingsResponse (..),
    newUpdateAccountSettingsResponse,

    -- * Response Lenses
    updateAccountSettingsResponse_requestId,
    updateAccountSettingsResponse_status,
  )
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 Amazonka.QuickSight.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateAccountSettings' smart constructor.
data UpdateAccountSettings = UpdateAccountSettings'
  { -- | The email address that you want Amazon QuickSight to send notifications
    -- to regarding your Amazon Web Services account or Amazon QuickSight
    -- subscription.
    UpdateAccountSettings -> Maybe Text
notificationEmail :: Prelude.Maybe Prelude.Text,
    -- | A boolean value that determines whether or not an Amazon QuickSight
    -- account can be deleted. A @True@ value doesn\'t allow the account to be
    -- deleted and results in an error message if a user tries to make a
    -- @DeleteAccountSubscription@ request. A @False@ value will allow the
    -- account to be deleted.
    UpdateAccountSettings -> Maybe Bool
terminationProtectionEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The ID for the Amazon Web Services account that contains the Amazon
    -- QuickSight settings that you want to list.
    UpdateAccountSettings -> Text
awsAccountId :: Prelude.Text,
    -- | The default namespace for this Amazon Web Services account. Currently,
    -- the default is @default@. Identity and Access Management (IAM) users
    -- that register for the first time with Amazon QuickSight provide an email
    -- address that becomes associated with the default namespace.
    UpdateAccountSettings -> Text
defaultNamespace :: Prelude.Text
  }
  deriving (UpdateAccountSettings -> UpdateAccountSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAccountSettings -> UpdateAccountSettings -> Bool
$c/= :: UpdateAccountSettings -> UpdateAccountSettings -> Bool
== :: UpdateAccountSettings -> UpdateAccountSettings -> Bool
$c== :: UpdateAccountSettings -> UpdateAccountSettings -> Bool
Prelude.Eq, ReadPrec [UpdateAccountSettings]
ReadPrec UpdateAccountSettings
Int -> ReadS UpdateAccountSettings
ReadS [UpdateAccountSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAccountSettings]
$creadListPrec :: ReadPrec [UpdateAccountSettings]
readPrec :: ReadPrec UpdateAccountSettings
$creadPrec :: ReadPrec UpdateAccountSettings
readList :: ReadS [UpdateAccountSettings]
$creadList :: ReadS [UpdateAccountSettings]
readsPrec :: Int -> ReadS UpdateAccountSettings
$creadsPrec :: Int -> ReadS UpdateAccountSettings
Prelude.Read, Int -> UpdateAccountSettings -> ShowS
[UpdateAccountSettings] -> ShowS
UpdateAccountSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAccountSettings] -> ShowS
$cshowList :: [UpdateAccountSettings] -> ShowS
show :: UpdateAccountSettings -> String
$cshow :: UpdateAccountSettings -> String
showsPrec :: Int -> UpdateAccountSettings -> ShowS
$cshowsPrec :: Int -> UpdateAccountSettings -> ShowS
Prelude.Show, forall x. Rep UpdateAccountSettings x -> UpdateAccountSettings
forall x. UpdateAccountSettings -> Rep UpdateAccountSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateAccountSettings x -> UpdateAccountSettings
$cfrom :: forall x. UpdateAccountSettings -> Rep UpdateAccountSettings x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAccountSettings' 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:
--
-- 'notificationEmail', 'updateAccountSettings_notificationEmail' - The email address that you want Amazon QuickSight to send notifications
-- to regarding your Amazon Web Services account or Amazon QuickSight
-- subscription.
--
-- 'terminationProtectionEnabled', 'updateAccountSettings_terminationProtectionEnabled' - A boolean value that determines whether or not an Amazon QuickSight
-- account can be deleted. A @True@ value doesn\'t allow the account to be
-- deleted and results in an error message if a user tries to make a
-- @DeleteAccountSubscription@ request. A @False@ value will allow the
-- account to be deleted.
--
-- 'awsAccountId', 'updateAccountSettings_awsAccountId' - The ID for the Amazon Web Services account that contains the Amazon
-- QuickSight settings that you want to list.
--
-- 'defaultNamespace', 'updateAccountSettings_defaultNamespace' - The default namespace for this Amazon Web Services account. Currently,
-- the default is @default@. Identity and Access Management (IAM) users
-- that register for the first time with Amazon QuickSight provide an email
-- address that becomes associated with the default namespace.
newUpdateAccountSettings ::
  -- | 'awsAccountId'
  Prelude.Text ->
  -- | 'defaultNamespace'
  Prelude.Text ->
  UpdateAccountSettings
newUpdateAccountSettings :: Text -> Text -> UpdateAccountSettings
newUpdateAccountSettings
  Text
pAwsAccountId_
  Text
pDefaultNamespace_ =
    UpdateAccountSettings'
      { $sel:notificationEmail:UpdateAccountSettings' :: Maybe Text
notificationEmail =
          forall a. Maybe a
Prelude.Nothing,
        $sel:terminationProtectionEnabled:UpdateAccountSettings' :: Maybe Bool
terminationProtectionEnabled = forall a. Maybe a
Prelude.Nothing,
        $sel:awsAccountId:UpdateAccountSettings' :: Text
awsAccountId = Text
pAwsAccountId_,
        $sel:defaultNamespace:UpdateAccountSettings' :: Text
defaultNamespace = Text
pDefaultNamespace_
      }

-- | The email address that you want Amazon QuickSight to send notifications
-- to regarding your Amazon Web Services account or Amazon QuickSight
-- subscription.
updateAccountSettings_notificationEmail :: Lens.Lens' UpdateAccountSettings (Prelude.Maybe Prelude.Text)
updateAccountSettings_notificationEmail :: Lens' UpdateAccountSettings (Maybe Text)
updateAccountSettings_notificationEmail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountSettings' {Maybe Text
notificationEmail :: Maybe Text
$sel:notificationEmail:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Text
notificationEmail} -> Maybe Text
notificationEmail) (\s :: UpdateAccountSettings
s@UpdateAccountSettings' {} Maybe Text
a -> UpdateAccountSettings
s {$sel:notificationEmail:UpdateAccountSettings' :: Maybe Text
notificationEmail = Maybe Text
a} :: UpdateAccountSettings)

-- | A boolean value that determines whether or not an Amazon QuickSight
-- account can be deleted. A @True@ value doesn\'t allow the account to be
-- deleted and results in an error message if a user tries to make a
-- @DeleteAccountSubscription@ request. A @False@ value will allow the
-- account to be deleted.
updateAccountSettings_terminationProtectionEnabled :: Lens.Lens' UpdateAccountSettings (Prelude.Maybe Prelude.Bool)
updateAccountSettings_terminationProtectionEnabled :: Lens' UpdateAccountSettings (Maybe Bool)
updateAccountSettings_terminationProtectionEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountSettings' {Maybe Bool
terminationProtectionEnabled :: Maybe Bool
$sel:terminationProtectionEnabled:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Bool
terminationProtectionEnabled} -> Maybe Bool
terminationProtectionEnabled) (\s :: UpdateAccountSettings
s@UpdateAccountSettings' {} Maybe Bool
a -> UpdateAccountSettings
s {$sel:terminationProtectionEnabled:UpdateAccountSettings' :: Maybe Bool
terminationProtectionEnabled = Maybe Bool
a} :: UpdateAccountSettings)

-- | The ID for the Amazon Web Services account that contains the Amazon
-- QuickSight settings that you want to list.
updateAccountSettings_awsAccountId :: Lens.Lens' UpdateAccountSettings Prelude.Text
updateAccountSettings_awsAccountId :: Lens' UpdateAccountSettings Text
updateAccountSettings_awsAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountSettings' {Text
awsAccountId :: Text
$sel:awsAccountId:UpdateAccountSettings' :: UpdateAccountSettings -> Text
awsAccountId} -> Text
awsAccountId) (\s :: UpdateAccountSettings
s@UpdateAccountSettings' {} Text
a -> UpdateAccountSettings
s {$sel:awsAccountId:UpdateAccountSettings' :: Text
awsAccountId = Text
a} :: UpdateAccountSettings)

-- | The default namespace for this Amazon Web Services account. Currently,
-- the default is @default@. Identity and Access Management (IAM) users
-- that register for the first time with Amazon QuickSight provide an email
-- address that becomes associated with the default namespace.
updateAccountSettings_defaultNamespace :: Lens.Lens' UpdateAccountSettings Prelude.Text
updateAccountSettings_defaultNamespace :: Lens' UpdateAccountSettings Text
updateAccountSettings_defaultNamespace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountSettings' {Text
defaultNamespace :: Text
$sel:defaultNamespace:UpdateAccountSettings' :: UpdateAccountSettings -> Text
defaultNamespace} -> Text
defaultNamespace) (\s :: UpdateAccountSettings
s@UpdateAccountSettings' {} Text
a -> UpdateAccountSettings
s {$sel:defaultNamespace:UpdateAccountSettings' :: Text
defaultNamespace = Text
a} :: UpdateAccountSettings)

instance Core.AWSRequest UpdateAccountSettings where
  type
    AWSResponse UpdateAccountSettings =
      UpdateAccountSettingsResponse
  request :: (Service -> Service)
-> UpdateAccountSettings -> Request UpdateAccountSettings
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 UpdateAccountSettings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateAccountSettings)))
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 -> UpdateAccountSettingsResponse
UpdateAccountSettingsResponse'
            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
"RequestId")
            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 UpdateAccountSettings where
  hashWithSalt :: Int -> UpdateAccountSettings -> Int
hashWithSalt Int
_salt UpdateAccountSettings' {Maybe Bool
Maybe Text
Text
defaultNamespace :: Text
awsAccountId :: Text
terminationProtectionEnabled :: Maybe Bool
notificationEmail :: Maybe Text
$sel:defaultNamespace:UpdateAccountSettings' :: UpdateAccountSettings -> Text
$sel:awsAccountId:UpdateAccountSettings' :: UpdateAccountSettings -> Text
$sel:terminationProtectionEnabled:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Bool
$sel:notificationEmail:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
notificationEmail
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
terminationProtectionEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
awsAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
defaultNamespace

instance Prelude.NFData UpdateAccountSettings where
  rnf :: UpdateAccountSettings -> ()
rnf UpdateAccountSettings' {Maybe Bool
Maybe Text
Text
defaultNamespace :: Text
awsAccountId :: Text
terminationProtectionEnabled :: Maybe Bool
notificationEmail :: Maybe Text
$sel:defaultNamespace:UpdateAccountSettings' :: UpdateAccountSettings -> Text
$sel:awsAccountId:UpdateAccountSettings' :: UpdateAccountSettings -> Text
$sel:terminationProtectionEnabled:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Bool
$sel:notificationEmail:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
notificationEmail
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
terminationProtectionEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
awsAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
defaultNamespace

instance Data.ToHeaders UpdateAccountSettings where
  toHeaders :: UpdateAccountSettings -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateAccountSettings where
  toJSON :: UpdateAccountSettings -> Value
toJSON UpdateAccountSettings' {Maybe Bool
Maybe Text
Text
defaultNamespace :: Text
awsAccountId :: Text
terminationProtectionEnabled :: Maybe Bool
notificationEmail :: Maybe Text
$sel:defaultNamespace:UpdateAccountSettings' :: UpdateAccountSettings -> Text
$sel:awsAccountId:UpdateAccountSettings' :: UpdateAccountSettings -> Text
$sel:terminationProtectionEnabled:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Bool
$sel:notificationEmail:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"NotificationEmail" 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
notificationEmail,
            (Key
"TerminationProtectionEnabled" 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
terminationProtectionEnabled,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DefaultNamespace" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
defaultNamespace)
          ]
      )

instance Data.ToPath UpdateAccountSettings where
  toPath :: UpdateAccountSettings -> ByteString
toPath UpdateAccountSettings' {Maybe Bool
Maybe Text
Text
defaultNamespace :: Text
awsAccountId :: Text
terminationProtectionEnabled :: Maybe Bool
notificationEmail :: Maybe Text
$sel:defaultNamespace:UpdateAccountSettings' :: UpdateAccountSettings -> Text
$sel:awsAccountId:UpdateAccountSettings' :: UpdateAccountSettings -> Text
$sel:terminationProtectionEnabled:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Bool
$sel:notificationEmail:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/accounts/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
awsAccountId, ByteString
"/settings"]

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

-- | /See:/ 'newUpdateAccountSettingsResponse' smart constructor.
data UpdateAccountSettingsResponse = UpdateAccountSettingsResponse'
  { -- | The Amazon Web Services request ID for this operation.
    UpdateAccountSettingsResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | The HTTP status of the request.
    UpdateAccountSettingsResponse -> Int
status :: Prelude.Int
  }
  deriving (UpdateAccountSettingsResponse
-> UpdateAccountSettingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAccountSettingsResponse
-> UpdateAccountSettingsResponse -> Bool
$c/= :: UpdateAccountSettingsResponse
-> UpdateAccountSettingsResponse -> Bool
== :: UpdateAccountSettingsResponse
-> UpdateAccountSettingsResponse -> Bool
$c== :: UpdateAccountSettingsResponse
-> UpdateAccountSettingsResponse -> Bool
Prelude.Eq, ReadPrec [UpdateAccountSettingsResponse]
ReadPrec UpdateAccountSettingsResponse
Int -> ReadS UpdateAccountSettingsResponse
ReadS [UpdateAccountSettingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAccountSettingsResponse]
$creadListPrec :: ReadPrec [UpdateAccountSettingsResponse]
readPrec :: ReadPrec UpdateAccountSettingsResponse
$creadPrec :: ReadPrec UpdateAccountSettingsResponse
readList :: ReadS [UpdateAccountSettingsResponse]
$creadList :: ReadS [UpdateAccountSettingsResponse]
readsPrec :: Int -> ReadS UpdateAccountSettingsResponse
$creadsPrec :: Int -> ReadS UpdateAccountSettingsResponse
Prelude.Read, Int -> UpdateAccountSettingsResponse -> ShowS
[UpdateAccountSettingsResponse] -> ShowS
UpdateAccountSettingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAccountSettingsResponse] -> ShowS
$cshowList :: [UpdateAccountSettingsResponse] -> ShowS
show :: UpdateAccountSettingsResponse -> String
$cshow :: UpdateAccountSettingsResponse -> String
showsPrec :: Int -> UpdateAccountSettingsResponse -> ShowS
$cshowsPrec :: Int -> UpdateAccountSettingsResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateAccountSettingsResponse x
-> UpdateAccountSettingsResponse
forall x.
UpdateAccountSettingsResponse
-> Rep UpdateAccountSettingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateAccountSettingsResponse x
-> UpdateAccountSettingsResponse
$cfrom :: forall x.
UpdateAccountSettingsResponse
-> Rep UpdateAccountSettingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAccountSettingsResponse' 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:
--
-- 'requestId', 'updateAccountSettingsResponse_requestId' - The Amazon Web Services request ID for this operation.
--
-- 'status', 'updateAccountSettingsResponse_status' - The HTTP status of the request.
newUpdateAccountSettingsResponse ::
  -- | 'status'
  Prelude.Int ->
  UpdateAccountSettingsResponse
newUpdateAccountSettingsResponse :: Int -> UpdateAccountSettingsResponse
newUpdateAccountSettingsResponse Int
pStatus_ =
  UpdateAccountSettingsResponse'
    { $sel:requestId:UpdateAccountSettingsResponse' :: Maybe Text
requestId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:status:UpdateAccountSettingsResponse' :: Int
status = Int
pStatus_
    }

-- | The Amazon Web Services request ID for this operation.
updateAccountSettingsResponse_requestId :: Lens.Lens' UpdateAccountSettingsResponse (Prelude.Maybe Prelude.Text)
updateAccountSettingsResponse_requestId :: Lens' UpdateAccountSettingsResponse (Maybe Text)
updateAccountSettingsResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountSettingsResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:UpdateAccountSettingsResponse' :: UpdateAccountSettingsResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: UpdateAccountSettingsResponse
s@UpdateAccountSettingsResponse' {} Maybe Text
a -> UpdateAccountSettingsResponse
s {$sel:requestId:UpdateAccountSettingsResponse' :: Maybe Text
requestId = Maybe Text
a} :: UpdateAccountSettingsResponse)

-- | The HTTP status of the request.
updateAccountSettingsResponse_status :: Lens.Lens' UpdateAccountSettingsResponse Prelude.Int
updateAccountSettingsResponse_status :: Lens' UpdateAccountSettingsResponse Int
updateAccountSettingsResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountSettingsResponse' {Int
status :: Int
$sel:status:UpdateAccountSettingsResponse' :: UpdateAccountSettingsResponse -> Int
status} -> Int
status) (\s :: UpdateAccountSettingsResponse
s@UpdateAccountSettingsResponse' {} Int
a -> UpdateAccountSettingsResponse
s {$sel:status:UpdateAccountSettingsResponse' :: Int
status = Int
a} :: UpdateAccountSettingsResponse)

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