{-# 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.AppRunner.CreateAutoScalingConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create an App Runner automatic scaling configuration resource. App
-- Runner requires this resource when you create or update App Runner
-- services and you require non-default auto scaling settings. You can
-- share an auto scaling configuration across multiple services.
--
-- Create multiple revisions of a configuration by calling this action
-- multiple times using the same @AutoScalingConfigurationName@. The call
-- returns incremental @AutoScalingConfigurationRevision@ values. When you
-- create a service and configure an auto scaling configuration resource,
-- the service uses the latest active revision of the auto scaling
-- configuration by default. You can optionally configure the service to
-- use a specific revision.
--
-- Configure a higher @MinSize@ to increase the spread of your App Runner
-- service over more Availability Zones in the Amazon Web Services Region.
-- The tradeoff is a higher minimal cost.
--
-- Configure a lower @MaxSize@ to control your cost. The tradeoff is lower
-- responsiveness during peak demand.
module Amazonka.AppRunner.CreateAutoScalingConfiguration
  ( -- * Creating a Request
    CreateAutoScalingConfiguration (..),
    newCreateAutoScalingConfiguration,

    -- * Request Lenses
    createAutoScalingConfiguration_maxConcurrency,
    createAutoScalingConfiguration_maxSize,
    createAutoScalingConfiguration_minSize,
    createAutoScalingConfiguration_tags,
    createAutoScalingConfiguration_autoScalingConfigurationName,

    -- * Destructuring the Response
    CreateAutoScalingConfigurationResponse (..),
    newCreateAutoScalingConfigurationResponse,

    -- * Response Lenses
    createAutoScalingConfigurationResponse_httpStatus,
    createAutoScalingConfigurationResponse_autoScalingConfiguration,
  )
where

import Amazonka.AppRunner.Types
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

-- | /See:/ 'newCreateAutoScalingConfiguration' smart constructor.
data CreateAutoScalingConfiguration = CreateAutoScalingConfiguration'
  { -- | The maximum number of concurrent requests that you want an instance to
    -- process. If the number of concurrent requests exceeds this limit, App
    -- Runner scales up your service.
    --
    -- Default: @100@
    CreateAutoScalingConfiguration -> Maybe Natural
maxConcurrency :: Prelude.Maybe Prelude.Natural,
    -- | The maximum number of instances that your service scales up to. At most
    -- @MaxSize@ instances actively serve traffic for your service.
    --
    -- Default: @25@
    CreateAutoScalingConfiguration -> Maybe Natural
maxSize :: Prelude.Maybe Prelude.Natural,
    -- | The minimum number of instances that App Runner provisions for your
    -- service. The service always has at least @MinSize@ provisioned
    -- instances. Some of them actively serve traffic. The rest of them
    -- (provisioned and inactive instances) are a cost-effective compute
    -- capacity reserve and are ready to be quickly activated. You pay for
    -- memory usage of all the provisioned instances. You pay for CPU usage of
    -- only the active subset.
    --
    -- App Runner temporarily doubles the number of provisioned instances
    -- during deployments, to maintain the same capacity for both old and new
    -- code.
    --
    -- Default: @1@
    CreateAutoScalingConfiguration -> Maybe Natural
minSize :: Prelude.Maybe Prelude.Natural,
    -- | A list of metadata items that you can associate with your auto scaling
    -- configuration resource. A tag is a key-value pair.
    CreateAutoScalingConfiguration -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A name for the auto scaling configuration. When you use it for the first
    -- time in an Amazon Web Services Region, App Runner creates revision
    -- number @1@ of this name. When you use the same name in subsequent calls,
    -- App Runner creates incremental revisions of the configuration.
    --
    -- The name @DefaultConfiguration@ is reserved (it\'s the configuration
    -- that App Runner uses if you don\'t provide a custome one). You can\'t
    -- use it to create a new auto scaling configuration, and you can\'t create
    -- a revision of it.
    --
    -- When you want to use your own auto scaling configuration for your App
    -- Runner service, /create a configuration with a different name/, and then
    -- provide it when you create or update your service.
    CreateAutoScalingConfiguration -> Text
autoScalingConfigurationName :: Prelude.Text
  }
  deriving (CreateAutoScalingConfiguration
-> CreateAutoScalingConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAutoScalingConfiguration
-> CreateAutoScalingConfiguration -> Bool
$c/= :: CreateAutoScalingConfiguration
-> CreateAutoScalingConfiguration -> Bool
== :: CreateAutoScalingConfiguration
-> CreateAutoScalingConfiguration -> Bool
$c== :: CreateAutoScalingConfiguration
-> CreateAutoScalingConfiguration -> Bool
Prelude.Eq, ReadPrec [CreateAutoScalingConfiguration]
ReadPrec CreateAutoScalingConfiguration
Int -> ReadS CreateAutoScalingConfiguration
ReadS [CreateAutoScalingConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAutoScalingConfiguration]
$creadListPrec :: ReadPrec [CreateAutoScalingConfiguration]
readPrec :: ReadPrec CreateAutoScalingConfiguration
$creadPrec :: ReadPrec CreateAutoScalingConfiguration
readList :: ReadS [CreateAutoScalingConfiguration]
$creadList :: ReadS [CreateAutoScalingConfiguration]
readsPrec :: Int -> ReadS CreateAutoScalingConfiguration
$creadsPrec :: Int -> ReadS CreateAutoScalingConfiguration
Prelude.Read, Int -> CreateAutoScalingConfiguration -> ShowS
[CreateAutoScalingConfiguration] -> ShowS
CreateAutoScalingConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAutoScalingConfiguration] -> ShowS
$cshowList :: [CreateAutoScalingConfiguration] -> ShowS
show :: CreateAutoScalingConfiguration -> String
$cshow :: CreateAutoScalingConfiguration -> String
showsPrec :: Int -> CreateAutoScalingConfiguration -> ShowS
$cshowsPrec :: Int -> CreateAutoScalingConfiguration -> ShowS
Prelude.Show, forall x.
Rep CreateAutoScalingConfiguration x
-> CreateAutoScalingConfiguration
forall x.
CreateAutoScalingConfiguration
-> Rep CreateAutoScalingConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateAutoScalingConfiguration x
-> CreateAutoScalingConfiguration
$cfrom :: forall x.
CreateAutoScalingConfiguration
-> Rep CreateAutoScalingConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'CreateAutoScalingConfiguration' 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:
--
-- 'maxConcurrency', 'createAutoScalingConfiguration_maxConcurrency' - The maximum number of concurrent requests that you want an instance to
-- process. If the number of concurrent requests exceeds this limit, App
-- Runner scales up your service.
--
-- Default: @100@
--
-- 'maxSize', 'createAutoScalingConfiguration_maxSize' - The maximum number of instances that your service scales up to. At most
-- @MaxSize@ instances actively serve traffic for your service.
--
-- Default: @25@
--
-- 'minSize', 'createAutoScalingConfiguration_minSize' - The minimum number of instances that App Runner provisions for your
-- service. The service always has at least @MinSize@ provisioned
-- instances. Some of them actively serve traffic. The rest of them
-- (provisioned and inactive instances) are a cost-effective compute
-- capacity reserve and are ready to be quickly activated. You pay for
-- memory usage of all the provisioned instances. You pay for CPU usage of
-- only the active subset.
--
-- App Runner temporarily doubles the number of provisioned instances
-- during deployments, to maintain the same capacity for both old and new
-- code.
--
-- Default: @1@
--
-- 'tags', 'createAutoScalingConfiguration_tags' - A list of metadata items that you can associate with your auto scaling
-- configuration resource. A tag is a key-value pair.
--
-- 'autoScalingConfigurationName', 'createAutoScalingConfiguration_autoScalingConfigurationName' - A name for the auto scaling configuration. When you use it for the first
-- time in an Amazon Web Services Region, App Runner creates revision
-- number @1@ of this name. When you use the same name in subsequent calls,
-- App Runner creates incremental revisions of the configuration.
--
-- The name @DefaultConfiguration@ is reserved (it\'s the configuration
-- that App Runner uses if you don\'t provide a custome one). You can\'t
-- use it to create a new auto scaling configuration, and you can\'t create
-- a revision of it.
--
-- When you want to use your own auto scaling configuration for your App
-- Runner service, /create a configuration with a different name/, and then
-- provide it when you create or update your service.
newCreateAutoScalingConfiguration ::
  -- | 'autoScalingConfigurationName'
  Prelude.Text ->
  CreateAutoScalingConfiguration
newCreateAutoScalingConfiguration :: Text -> CreateAutoScalingConfiguration
newCreateAutoScalingConfiguration
  Text
pAutoScalingConfigurationName_ =
    CreateAutoScalingConfiguration'
      { $sel:maxConcurrency:CreateAutoScalingConfiguration' :: Maybe Natural
maxConcurrency =
          forall a. Maybe a
Prelude.Nothing,
        $sel:maxSize:CreateAutoScalingConfiguration' :: Maybe Natural
maxSize = forall a. Maybe a
Prelude.Nothing,
        $sel:minSize:CreateAutoScalingConfiguration' :: Maybe Natural
minSize = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateAutoScalingConfiguration' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:autoScalingConfigurationName:CreateAutoScalingConfiguration' :: Text
autoScalingConfigurationName =
          Text
pAutoScalingConfigurationName_
      }

-- | The maximum number of concurrent requests that you want an instance to
-- process. If the number of concurrent requests exceeds this limit, App
-- Runner scales up your service.
--
-- Default: @100@
createAutoScalingConfiguration_maxConcurrency :: Lens.Lens' CreateAutoScalingConfiguration (Prelude.Maybe Prelude.Natural)
createAutoScalingConfiguration_maxConcurrency :: Lens' CreateAutoScalingConfiguration (Maybe Natural)
createAutoScalingConfiguration_maxConcurrency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAutoScalingConfiguration' {Maybe Natural
maxConcurrency :: Maybe Natural
$sel:maxConcurrency:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe Natural
maxConcurrency} -> Maybe Natural
maxConcurrency) (\s :: CreateAutoScalingConfiguration
s@CreateAutoScalingConfiguration' {} Maybe Natural
a -> CreateAutoScalingConfiguration
s {$sel:maxConcurrency:CreateAutoScalingConfiguration' :: Maybe Natural
maxConcurrency = Maybe Natural
a} :: CreateAutoScalingConfiguration)

-- | The maximum number of instances that your service scales up to. At most
-- @MaxSize@ instances actively serve traffic for your service.
--
-- Default: @25@
createAutoScalingConfiguration_maxSize :: Lens.Lens' CreateAutoScalingConfiguration (Prelude.Maybe Prelude.Natural)
createAutoScalingConfiguration_maxSize :: Lens' CreateAutoScalingConfiguration (Maybe Natural)
createAutoScalingConfiguration_maxSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAutoScalingConfiguration' {Maybe Natural
maxSize :: Maybe Natural
$sel:maxSize:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe Natural
maxSize} -> Maybe Natural
maxSize) (\s :: CreateAutoScalingConfiguration
s@CreateAutoScalingConfiguration' {} Maybe Natural
a -> CreateAutoScalingConfiguration
s {$sel:maxSize:CreateAutoScalingConfiguration' :: Maybe Natural
maxSize = Maybe Natural
a} :: CreateAutoScalingConfiguration)

-- | The minimum number of instances that App Runner provisions for your
-- service. The service always has at least @MinSize@ provisioned
-- instances. Some of them actively serve traffic. The rest of them
-- (provisioned and inactive instances) are a cost-effective compute
-- capacity reserve and are ready to be quickly activated. You pay for
-- memory usage of all the provisioned instances. You pay for CPU usage of
-- only the active subset.
--
-- App Runner temporarily doubles the number of provisioned instances
-- during deployments, to maintain the same capacity for both old and new
-- code.
--
-- Default: @1@
createAutoScalingConfiguration_minSize :: Lens.Lens' CreateAutoScalingConfiguration (Prelude.Maybe Prelude.Natural)
createAutoScalingConfiguration_minSize :: Lens' CreateAutoScalingConfiguration (Maybe Natural)
createAutoScalingConfiguration_minSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAutoScalingConfiguration' {Maybe Natural
minSize :: Maybe Natural
$sel:minSize:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe Natural
minSize} -> Maybe Natural
minSize) (\s :: CreateAutoScalingConfiguration
s@CreateAutoScalingConfiguration' {} Maybe Natural
a -> CreateAutoScalingConfiguration
s {$sel:minSize:CreateAutoScalingConfiguration' :: Maybe Natural
minSize = Maybe Natural
a} :: CreateAutoScalingConfiguration)

-- | A list of metadata items that you can associate with your auto scaling
-- configuration resource. A tag is a key-value pair.
createAutoScalingConfiguration_tags :: Lens.Lens' CreateAutoScalingConfiguration (Prelude.Maybe [Tag])
createAutoScalingConfiguration_tags :: Lens' CreateAutoScalingConfiguration (Maybe [Tag])
createAutoScalingConfiguration_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAutoScalingConfiguration' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateAutoScalingConfiguration
s@CreateAutoScalingConfiguration' {} Maybe [Tag]
a -> CreateAutoScalingConfiguration
s {$sel:tags:CreateAutoScalingConfiguration' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateAutoScalingConfiguration) 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 auto scaling configuration. When you use it for the first
-- time in an Amazon Web Services Region, App Runner creates revision
-- number @1@ of this name. When you use the same name in subsequent calls,
-- App Runner creates incremental revisions of the configuration.
--
-- The name @DefaultConfiguration@ is reserved (it\'s the configuration
-- that App Runner uses if you don\'t provide a custome one). You can\'t
-- use it to create a new auto scaling configuration, and you can\'t create
-- a revision of it.
--
-- When you want to use your own auto scaling configuration for your App
-- Runner service, /create a configuration with a different name/, and then
-- provide it when you create or update your service.
createAutoScalingConfiguration_autoScalingConfigurationName :: Lens.Lens' CreateAutoScalingConfiguration Prelude.Text
createAutoScalingConfiguration_autoScalingConfigurationName :: Lens' CreateAutoScalingConfiguration Text
createAutoScalingConfiguration_autoScalingConfigurationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAutoScalingConfiguration' {Text
autoScalingConfigurationName :: Text
$sel:autoScalingConfigurationName:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Text
autoScalingConfigurationName} -> Text
autoScalingConfigurationName) (\s :: CreateAutoScalingConfiguration
s@CreateAutoScalingConfiguration' {} Text
a -> CreateAutoScalingConfiguration
s {$sel:autoScalingConfigurationName:CreateAutoScalingConfiguration' :: Text
autoScalingConfigurationName = Text
a} :: CreateAutoScalingConfiguration)

instance
  Core.AWSRequest
    CreateAutoScalingConfiguration
  where
  type
    AWSResponse CreateAutoScalingConfiguration =
      CreateAutoScalingConfigurationResponse
  request :: (Service -> Service)
-> CreateAutoScalingConfiguration
-> Request CreateAutoScalingConfiguration
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 CreateAutoScalingConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateAutoScalingConfiguration)))
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 ->
          Int
-> AutoScalingConfiguration
-> CreateAutoScalingConfigurationResponse
CreateAutoScalingConfigurationResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"AutoScalingConfiguration")
      )

instance
  Prelude.Hashable
    CreateAutoScalingConfiguration
  where
  hashWithSalt :: Int -> CreateAutoScalingConfiguration -> Int
hashWithSalt
    Int
_salt
    CreateAutoScalingConfiguration' {Maybe Natural
Maybe [Tag]
Text
autoScalingConfigurationName :: Text
tags :: Maybe [Tag]
minSize :: Maybe Natural
maxSize :: Maybe Natural
maxConcurrency :: Maybe Natural
$sel:autoScalingConfigurationName:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Text
$sel:tags:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe [Tag]
$sel:minSize:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe Natural
$sel:maxSize:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe Natural
$sel:maxConcurrency:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe Natural
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxConcurrency
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxSize
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
minSize
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
autoScalingConfigurationName

instance
  Prelude.NFData
    CreateAutoScalingConfiguration
  where
  rnf :: CreateAutoScalingConfiguration -> ()
rnf CreateAutoScalingConfiguration' {Maybe Natural
Maybe [Tag]
Text
autoScalingConfigurationName :: Text
tags :: Maybe [Tag]
minSize :: Maybe Natural
maxSize :: Maybe Natural
maxConcurrency :: Maybe Natural
$sel:autoScalingConfigurationName:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Text
$sel:tags:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe [Tag]
$sel:minSize:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe Natural
$sel:maxSize:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe Natural
$sel:maxConcurrency:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxConcurrency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
minSize
      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
autoScalingConfigurationName

instance
  Data.ToHeaders
    CreateAutoScalingConfiguration
  where
  toHeaders :: CreateAutoScalingConfiguration -> 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
"AppRunner.CreateAutoScalingConfiguration" ::
                          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 CreateAutoScalingConfiguration where
  toJSON :: CreateAutoScalingConfiguration -> Value
toJSON CreateAutoScalingConfiguration' {Maybe Natural
Maybe [Tag]
Text
autoScalingConfigurationName :: Text
tags :: Maybe [Tag]
minSize :: Maybe Natural
maxSize :: Maybe Natural
maxConcurrency :: Maybe Natural
$sel:autoScalingConfigurationName:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Text
$sel:tags:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe [Tag]
$sel:minSize:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe Natural
$sel:maxSize:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe Natural
$sel:maxConcurrency:CreateAutoScalingConfiguration' :: CreateAutoScalingConfiguration -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxConcurrency" 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 Natural
maxConcurrency,
            (Key
"MaxSize" 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 Natural
maxSize,
            (Key
"MinSize" 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 Natural
minSize,
            (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
"AutoScalingConfigurationName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
autoScalingConfigurationName
              )
          ]
      )

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

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

-- | /See:/ 'newCreateAutoScalingConfigurationResponse' smart constructor.
data CreateAutoScalingConfigurationResponse = CreateAutoScalingConfigurationResponse'
  { -- | The response's http status code.
    CreateAutoScalingConfigurationResponse -> Int
httpStatus :: Prelude.Int,
    -- | A description of the App Runner auto scaling configuration that\'s
    -- created by this request.
    CreateAutoScalingConfigurationResponse -> AutoScalingConfiguration
autoScalingConfiguration :: AutoScalingConfiguration
  }
  deriving (CreateAutoScalingConfigurationResponse
-> CreateAutoScalingConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAutoScalingConfigurationResponse
-> CreateAutoScalingConfigurationResponse -> Bool
$c/= :: CreateAutoScalingConfigurationResponse
-> CreateAutoScalingConfigurationResponse -> Bool
== :: CreateAutoScalingConfigurationResponse
-> CreateAutoScalingConfigurationResponse -> Bool
$c== :: CreateAutoScalingConfigurationResponse
-> CreateAutoScalingConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [CreateAutoScalingConfigurationResponse]
ReadPrec CreateAutoScalingConfigurationResponse
Int -> ReadS CreateAutoScalingConfigurationResponse
ReadS [CreateAutoScalingConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAutoScalingConfigurationResponse]
$creadListPrec :: ReadPrec [CreateAutoScalingConfigurationResponse]
readPrec :: ReadPrec CreateAutoScalingConfigurationResponse
$creadPrec :: ReadPrec CreateAutoScalingConfigurationResponse
readList :: ReadS [CreateAutoScalingConfigurationResponse]
$creadList :: ReadS [CreateAutoScalingConfigurationResponse]
readsPrec :: Int -> ReadS CreateAutoScalingConfigurationResponse
$creadsPrec :: Int -> ReadS CreateAutoScalingConfigurationResponse
Prelude.Read, Int -> CreateAutoScalingConfigurationResponse -> ShowS
[CreateAutoScalingConfigurationResponse] -> ShowS
CreateAutoScalingConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAutoScalingConfigurationResponse] -> ShowS
$cshowList :: [CreateAutoScalingConfigurationResponse] -> ShowS
show :: CreateAutoScalingConfigurationResponse -> String
$cshow :: CreateAutoScalingConfigurationResponse -> String
showsPrec :: Int -> CreateAutoScalingConfigurationResponse -> ShowS
$cshowsPrec :: Int -> CreateAutoScalingConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateAutoScalingConfigurationResponse x
-> CreateAutoScalingConfigurationResponse
forall x.
CreateAutoScalingConfigurationResponse
-> Rep CreateAutoScalingConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateAutoScalingConfigurationResponse x
-> CreateAutoScalingConfigurationResponse
$cfrom :: forall x.
CreateAutoScalingConfigurationResponse
-> Rep CreateAutoScalingConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateAutoScalingConfigurationResponse' 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:
--
-- 'httpStatus', 'createAutoScalingConfigurationResponse_httpStatus' - The response's http status code.
--
-- 'autoScalingConfiguration', 'createAutoScalingConfigurationResponse_autoScalingConfiguration' - A description of the App Runner auto scaling configuration that\'s
-- created by this request.
newCreateAutoScalingConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'autoScalingConfiguration'
  AutoScalingConfiguration ->
  CreateAutoScalingConfigurationResponse
newCreateAutoScalingConfigurationResponse :: Int
-> AutoScalingConfiguration
-> CreateAutoScalingConfigurationResponse
newCreateAutoScalingConfigurationResponse
  Int
pHttpStatus_
  AutoScalingConfiguration
pAutoScalingConfiguration_ =
    CreateAutoScalingConfigurationResponse'
      { $sel:httpStatus:CreateAutoScalingConfigurationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:autoScalingConfiguration:CreateAutoScalingConfigurationResponse' :: AutoScalingConfiguration
autoScalingConfiguration =
          AutoScalingConfiguration
pAutoScalingConfiguration_
      }

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

-- | A description of the App Runner auto scaling configuration that\'s
-- created by this request.
createAutoScalingConfigurationResponse_autoScalingConfiguration :: Lens.Lens' CreateAutoScalingConfigurationResponse AutoScalingConfiguration
createAutoScalingConfigurationResponse_autoScalingConfiguration :: Lens'
  CreateAutoScalingConfigurationResponse AutoScalingConfiguration
createAutoScalingConfigurationResponse_autoScalingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAutoScalingConfigurationResponse' {AutoScalingConfiguration
autoScalingConfiguration :: AutoScalingConfiguration
$sel:autoScalingConfiguration:CreateAutoScalingConfigurationResponse' :: CreateAutoScalingConfigurationResponse -> AutoScalingConfiguration
autoScalingConfiguration} -> AutoScalingConfiguration
autoScalingConfiguration) (\s :: CreateAutoScalingConfigurationResponse
s@CreateAutoScalingConfigurationResponse' {} AutoScalingConfiguration
a -> CreateAutoScalingConfigurationResponse
s {$sel:autoScalingConfiguration:CreateAutoScalingConfigurationResponse' :: AutoScalingConfiguration
autoScalingConfiguration = AutoScalingConfiguration
a} :: CreateAutoScalingConfigurationResponse)

instance
  Prelude.NFData
    CreateAutoScalingConfigurationResponse
  where
  rnf :: CreateAutoScalingConfigurationResponse -> ()
rnf CreateAutoScalingConfigurationResponse' {Int
AutoScalingConfiguration
autoScalingConfiguration :: AutoScalingConfiguration
httpStatus :: Int
$sel:autoScalingConfiguration:CreateAutoScalingConfigurationResponse' :: CreateAutoScalingConfigurationResponse -> AutoScalingConfiguration
$sel:httpStatus:CreateAutoScalingConfigurationResponse' :: CreateAutoScalingConfigurationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AutoScalingConfiguration
autoScalingConfiguration