{-# 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.OpenSearchServerless.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)
--
-- Update the OpenSearch Serverless settings for the current Amazon Web
-- Services account. For more information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/serverless-overview.html#serverless-scaling Autoscaling>.
module Amazonka.OpenSearchServerless.UpdateAccountSettings
  ( -- * Creating a Request
    UpdateAccountSettings (..),
    newUpdateAccountSettings,

    -- * Request Lenses
    updateAccountSettings_capacityLimits,

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

    -- * Response Lenses
    updateAccountSettingsResponse_accountSettingsDetail,
    updateAccountSettingsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateAccountSettings' smart constructor.
data UpdateAccountSettings = UpdateAccountSettings'
  { UpdateAccountSettings -> Maybe CapacityLimits
capacityLimits :: Prelude.Maybe CapacityLimits
  }
  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:
--
-- 'capacityLimits', 'updateAccountSettings_capacityLimits' - Undocumented member.
newUpdateAccountSettings ::
  UpdateAccountSettings
newUpdateAccountSettings :: UpdateAccountSettings
newUpdateAccountSettings =
  UpdateAccountSettings'
    { $sel:capacityLimits:UpdateAccountSettings' :: Maybe CapacityLimits
capacityLimits =
        forall a. Maybe a
Prelude.Nothing
    }

-- | Undocumented member.
updateAccountSettings_capacityLimits :: Lens.Lens' UpdateAccountSettings (Prelude.Maybe CapacityLimits)
updateAccountSettings_capacityLimits :: Lens' UpdateAccountSettings (Maybe CapacityLimits)
updateAccountSettings_capacityLimits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountSettings' {Maybe CapacityLimits
capacityLimits :: Maybe CapacityLimits
$sel:capacityLimits:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe CapacityLimits
capacityLimits} -> Maybe CapacityLimits
capacityLimits) (\s :: UpdateAccountSettings
s@UpdateAccountSettings' {} Maybe CapacityLimits
a -> UpdateAccountSettings
s {$sel:capacityLimits:UpdateAccountSettings' :: Maybe CapacityLimits
capacityLimits = Maybe CapacityLimits
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.postJSON (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 AccountSettingsDetail -> 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
"accountSettingsDetail")
            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 CapacityLimits
capacityLimits :: Maybe CapacityLimits
$sel:capacityLimits:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe CapacityLimits
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CapacityLimits
capacityLimits

instance Prelude.NFData UpdateAccountSettings where
  rnf :: UpdateAccountSettings -> ()
rnf UpdateAccountSettings' {Maybe CapacityLimits
capacityLimits :: Maybe CapacityLimits
$sel:capacityLimits:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe CapacityLimits
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CapacityLimits
capacityLimits

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
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"OpenSearchServerless.UpdateAccountSettings" ::
                          Prelude.ByteString
                      ),
            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 CapacityLimits
capacityLimits :: Maybe CapacityLimits
$sel:capacityLimits:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe CapacityLimits
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"capacityLimits" 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 CapacityLimits
capacityLimits
          ]
      )

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

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'
  { -- | OpenSearch Serverless-related settings for the current Amazon Web
    -- Services account.
    UpdateAccountSettingsResponse -> Maybe AccountSettingsDetail
accountSettingsDetail :: Prelude.Maybe AccountSettingsDetail,
    -- | The response's http status code.
    UpdateAccountSettingsResponse -> Int
httpStatus :: 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:
--
-- 'accountSettingsDetail', 'updateAccountSettingsResponse_accountSettingsDetail' - OpenSearch Serverless-related settings for the current Amazon Web
-- Services account.
--
-- 'httpStatus', 'updateAccountSettingsResponse_httpStatus' - The response's http status code.
newUpdateAccountSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateAccountSettingsResponse
newUpdateAccountSettingsResponse :: Int -> UpdateAccountSettingsResponse
newUpdateAccountSettingsResponse Int
pHttpStatus_ =
  UpdateAccountSettingsResponse'
    { $sel:accountSettingsDetail:UpdateAccountSettingsResponse' :: Maybe AccountSettingsDetail
accountSettingsDetail =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateAccountSettingsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | OpenSearch Serverless-related settings for the current Amazon Web
-- Services account.
updateAccountSettingsResponse_accountSettingsDetail :: Lens.Lens' UpdateAccountSettingsResponse (Prelude.Maybe AccountSettingsDetail)
updateAccountSettingsResponse_accountSettingsDetail :: Lens' UpdateAccountSettingsResponse (Maybe AccountSettingsDetail)
updateAccountSettingsResponse_accountSettingsDetail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountSettingsResponse' {Maybe AccountSettingsDetail
accountSettingsDetail :: Maybe AccountSettingsDetail
$sel:accountSettingsDetail:UpdateAccountSettingsResponse' :: UpdateAccountSettingsResponse -> Maybe AccountSettingsDetail
accountSettingsDetail} -> Maybe AccountSettingsDetail
accountSettingsDetail) (\s :: UpdateAccountSettingsResponse
s@UpdateAccountSettingsResponse' {} Maybe AccountSettingsDetail
a -> UpdateAccountSettingsResponse
s {$sel:accountSettingsDetail:UpdateAccountSettingsResponse' :: Maybe AccountSettingsDetail
accountSettingsDetail = Maybe AccountSettingsDetail
a} :: UpdateAccountSettingsResponse)

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

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