{-# 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.Lambda.GetProvisionedConcurrencyConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the provisioned concurrency configuration for a function\'s
-- alias or version.
module Amazonka.Lambda.GetProvisionedConcurrencyConfig
  ( -- * Creating a Request
    GetProvisionedConcurrencyConfig (..),
    newGetProvisionedConcurrencyConfig,

    -- * Request Lenses
    getProvisionedConcurrencyConfig_functionName,
    getProvisionedConcurrencyConfig_qualifier,

    -- * Destructuring the Response
    GetProvisionedConcurrencyConfigResponse (..),
    newGetProvisionedConcurrencyConfigResponse,

    -- * Response Lenses
    getProvisionedConcurrencyConfigResponse_allocatedProvisionedConcurrentExecutions,
    getProvisionedConcurrencyConfigResponse_availableProvisionedConcurrentExecutions,
    getProvisionedConcurrencyConfigResponse_lastModified,
    getProvisionedConcurrencyConfigResponse_requestedProvisionedConcurrentExecutions,
    getProvisionedConcurrencyConfigResponse_status,
    getProvisionedConcurrencyConfigResponse_statusReason,
    getProvisionedConcurrencyConfigResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetProvisionedConcurrencyConfig' smart constructor.
data GetProvisionedConcurrencyConfig = GetProvisionedConcurrencyConfig'
  { -- | The name of the Lambda function.
    --
    -- __Name formats__
    --
    -- -   __Function name__ – @my-function@.
    --
    -- -   __Function ARN__ –
    --     @arn:aws:lambda:us-west-2:123456789012:function:my-function@.
    --
    -- -   __Partial ARN__ – @123456789012:function:my-function@.
    --
    -- The length constraint applies only to the full ARN. If you specify only
    -- the function name, it is limited to 64 characters in length.
    GetProvisionedConcurrencyConfig -> Text
functionName :: Prelude.Text,
    -- | The version number or alias name.
    GetProvisionedConcurrencyConfig -> Text
qualifier :: Prelude.Text
  }
  deriving (GetProvisionedConcurrencyConfig
-> GetProvisionedConcurrencyConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetProvisionedConcurrencyConfig
-> GetProvisionedConcurrencyConfig -> Bool
$c/= :: GetProvisionedConcurrencyConfig
-> GetProvisionedConcurrencyConfig -> Bool
== :: GetProvisionedConcurrencyConfig
-> GetProvisionedConcurrencyConfig -> Bool
$c== :: GetProvisionedConcurrencyConfig
-> GetProvisionedConcurrencyConfig -> Bool
Prelude.Eq, ReadPrec [GetProvisionedConcurrencyConfig]
ReadPrec GetProvisionedConcurrencyConfig
Int -> ReadS GetProvisionedConcurrencyConfig
ReadS [GetProvisionedConcurrencyConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetProvisionedConcurrencyConfig]
$creadListPrec :: ReadPrec [GetProvisionedConcurrencyConfig]
readPrec :: ReadPrec GetProvisionedConcurrencyConfig
$creadPrec :: ReadPrec GetProvisionedConcurrencyConfig
readList :: ReadS [GetProvisionedConcurrencyConfig]
$creadList :: ReadS [GetProvisionedConcurrencyConfig]
readsPrec :: Int -> ReadS GetProvisionedConcurrencyConfig
$creadsPrec :: Int -> ReadS GetProvisionedConcurrencyConfig
Prelude.Read, Int -> GetProvisionedConcurrencyConfig -> ShowS
[GetProvisionedConcurrencyConfig] -> ShowS
GetProvisionedConcurrencyConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetProvisionedConcurrencyConfig] -> ShowS
$cshowList :: [GetProvisionedConcurrencyConfig] -> ShowS
show :: GetProvisionedConcurrencyConfig -> String
$cshow :: GetProvisionedConcurrencyConfig -> String
showsPrec :: Int -> GetProvisionedConcurrencyConfig -> ShowS
$cshowsPrec :: Int -> GetProvisionedConcurrencyConfig -> ShowS
Prelude.Show, forall x.
Rep GetProvisionedConcurrencyConfig x
-> GetProvisionedConcurrencyConfig
forall x.
GetProvisionedConcurrencyConfig
-> Rep GetProvisionedConcurrencyConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetProvisionedConcurrencyConfig x
-> GetProvisionedConcurrencyConfig
$cfrom :: forall x.
GetProvisionedConcurrencyConfig
-> Rep GetProvisionedConcurrencyConfig x
Prelude.Generic)

-- |
-- Create a value of 'GetProvisionedConcurrencyConfig' 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:
--
-- 'functionName', 'getProvisionedConcurrencyConfig_functionName' - The name of the Lambda function.
--
-- __Name formats__
--
-- -   __Function name__ – @my-function@.
--
-- -   __Function ARN__ –
--     @arn:aws:lambda:us-west-2:123456789012:function:my-function@.
--
-- -   __Partial ARN__ – @123456789012:function:my-function@.
--
-- The length constraint applies only to the full ARN. If you specify only
-- the function name, it is limited to 64 characters in length.
--
-- 'qualifier', 'getProvisionedConcurrencyConfig_qualifier' - The version number or alias name.
newGetProvisionedConcurrencyConfig ::
  -- | 'functionName'
  Prelude.Text ->
  -- | 'qualifier'
  Prelude.Text ->
  GetProvisionedConcurrencyConfig
newGetProvisionedConcurrencyConfig :: Text -> Text -> GetProvisionedConcurrencyConfig
newGetProvisionedConcurrencyConfig
  Text
pFunctionName_
  Text
pQualifier_ =
    GetProvisionedConcurrencyConfig'
      { $sel:functionName:GetProvisionedConcurrencyConfig' :: Text
functionName =
          Text
pFunctionName_,
        $sel:qualifier:GetProvisionedConcurrencyConfig' :: Text
qualifier = Text
pQualifier_
      }

-- | The name of the Lambda function.
--
-- __Name formats__
--
-- -   __Function name__ – @my-function@.
--
-- -   __Function ARN__ –
--     @arn:aws:lambda:us-west-2:123456789012:function:my-function@.
--
-- -   __Partial ARN__ – @123456789012:function:my-function@.
--
-- The length constraint applies only to the full ARN. If you specify only
-- the function name, it is limited to 64 characters in length.
getProvisionedConcurrencyConfig_functionName :: Lens.Lens' GetProvisionedConcurrencyConfig Prelude.Text
getProvisionedConcurrencyConfig_functionName :: Lens' GetProvisionedConcurrencyConfig Text
getProvisionedConcurrencyConfig_functionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedConcurrencyConfig' {Text
functionName :: Text
$sel:functionName:GetProvisionedConcurrencyConfig' :: GetProvisionedConcurrencyConfig -> Text
functionName} -> Text
functionName) (\s :: GetProvisionedConcurrencyConfig
s@GetProvisionedConcurrencyConfig' {} Text
a -> GetProvisionedConcurrencyConfig
s {$sel:functionName:GetProvisionedConcurrencyConfig' :: Text
functionName = Text
a} :: GetProvisionedConcurrencyConfig)

-- | The version number or alias name.
getProvisionedConcurrencyConfig_qualifier :: Lens.Lens' GetProvisionedConcurrencyConfig Prelude.Text
getProvisionedConcurrencyConfig_qualifier :: Lens' GetProvisionedConcurrencyConfig Text
getProvisionedConcurrencyConfig_qualifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedConcurrencyConfig' {Text
qualifier :: Text
$sel:qualifier:GetProvisionedConcurrencyConfig' :: GetProvisionedConcurrencyConfig -> Text
qualifier} -> Text
qualifier) (\s :: GetProvisionedConcurrencyConfig
s@GetProvisionedConcurrencyConfig' {} Text
a -> GetProvisionedConcurrencyConfig
s {$sel:qualifier:GetProvisionedConcurrencyConfig' :: Text
qualifier = Text
a} :: GetProvisionedConcurrencyConfig)

instance
  Core.AWSRequest
    GetProvisionedConcurrencyConfig
  where
  type
    AWSResponse GetProvisionedConcurrencyConfig =
      GetProvisionedConcurrencyConfigResponse
  request :: (Service -> Service)
-> GetProvisionedConcurrencyConfig
-> Request GetProvisionedConcurrencyConfig
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetProvisionedConcurrencyConfig
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetProvisionedConcurrencyConfig)))
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 Natural
-> Maybe Natural
-> Maybe Text
-> Maybe Natural
-> Maybe ProvisionedConcurrencyStatusEnum
-> Maybe Text
-> Int
-> GetProvisionedConcurrencyConfigResponse
GetProvisionedConcurrencyConfigResponse'
            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
"AllocatedProvisionedConcurrentExecutions"
                        )
            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
"AvailableProvisionedConcurrentExecutions"
                        )
            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
"LastModified")
            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
"RequestedProvisionedConcurrentExecutions"
                        )
            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
"Status")
            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
"StatusReason")
            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
    GetProvisionedConcurrencyConfig
  where
  hashWithSalt :: Int -> GetProvisionedConcurrencyConfig -> Int
hashWithSalt
    Int
_salt
    GetProvisionedConcurrencyConfig' {Text
qualifier :: Text
functionName :: Text
$sel:qualifier:GetProvisionedConcurrencyConfig' :: GetProvisionedConcurrencyConfig -> Text
$sel:functionName:GetProvisionedConcurrencyConfig' :: GetProvisionedConcurrencyConfig -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
functionName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
qualifier

instance
  Prelude.NFData
    GetProvisionedConcurrencyConfig
  where
  rnf :: GetProvisionedConcurrencyConfig -> ()
rnf GetProvisionedConcurrencyConfig' {Text
qualifier :: Text
functionName :: Text
$sel:qualifier:GetProvisionedConcurrencyConfig' :: GetProvisionedConcurrencyConfig -> Text
$sel:functionName:GetProvisionedConcurrencyConfig' :: GetProvisionedConcurrencyConfig -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
functionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
qualifier

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

instance Data.ToPath GetProvisionedConcurrencyConfig where
  toPath :: GetProvisionedConcurrencyConfig -> ByteString
toPath GetProvisionedConcurrencyConfig' {Text
qualifier :: Text
functionName :: Text
$sel:qualifier:GetProvisionedConcurrencyConfig' :: GetProvisionedConcurrencyConfig -> Text
$sel:functionName:GetProvisionedConcurrencyConfig' :: GetProvisionedConcurrencyConfig -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2019-09-30/functions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
functionName,
        ByteString
"/provisioned-concurrency"
      ]

instance Data.ToQuery GetProvisionedConcurrencyConfig where
  toQuery :: GetProvisionedConcurrencyConfig -> QueryString
toQuery GetProvisionedConcurrencyConfig' {Text
qualifier :: Text
functionName :: Text
$sel:qualifier:GetProvisionedConcurrencyConfig' :: GetProvisionedConcurrencyConfig -> Text
$sel:functionName:GetProvisionedConcurrencyConfig' :: GetProvisionedConcurrencyConfig -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"Qualifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
qualifier]

-- | /See:/ 'newGetProvisionedConcurrencyConfigResponse' smart constructor.
data GetProvisionedConcurrencyConfigResponse = GetProvisionedConcurrencyConfigResponse'
  { -- | The amount of provisioned concurrency allocated. When a weighted alias
    -- is used during linear and canary deployments, this value fluctuates
    -- depending on the amount of concurrency that is provisioned for the
    -- function versions.
    GetProvisionedConcurrencyConfigResponse -> Maybe Natural
allocatedProvisionedConcurrentExecutions :: Prelude.Maybe Prelude.Natural,
    -- | The amount of provisioned concurrency available.
    GetProvisionedConcurrencyConfigResponse -> Maybe Natural
availableProvisionedConcurrentExecutions :: Prelude.Maybe Prelude.Natural,
    -- | The date and time that a user last updated the configuration, in
    -- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601 format>.
    GetProvisionedConcurrencyConfigResponse -> Maybe Text
lastModified :: Prelude.Maybe Prelude.Text,
    -- | The amount of provisioned concurrency requested.
    GetProvisionedConcurrencyConfigResponse -> Maybe Natural
requestedProvisionedConcurrentExecutions :: Prelude.Maybe Prelude.Natural,
    -- | The status of the allocation process.
    GetProvisionedConcurrencyConfigResponse
-> Maybe ProvisionedConcurrencyStatusEnum
status :: Prelude.Maybe ProvisionedConcurrencyStatusEnum,
    -- | For failed allocations, the reason that provisioned concurrency could
    -- not be allocated.
    GetProvisionedConcurrencyConfigResponse -> Maybe Text
statusReason :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetProvisionedConcurrencyConfigResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetProvisionedConcurrencyConfigResponse
-> GetProvisionedConcurrencyConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetProvisionedConcurrencyConfigResponse
-> GetProvisionedConcurrencyConfigResponse -> Bool
$c/= :: GetProvisionedConcurrencyConfigResponse
-> GetProvisionedConcurrencyConfigResponse -> Bool
== :: GetProvisionedConcurrencyConfigResponse
-> GetProvisionedConcurrencyConfigResponse -> Bool
$c== :: GetProvisionedConcurrencyConfigResponse
-> GetProvisionedConcurrencyConfigResponse -> Bool
Prelude.Eq, ReadPrec [GetProvisionedConcurrencyConfigResponse]
ReadPrec GetProvisionedConcurrencyConfigResponse
Int -> ReadS GetProvisionedConcurrencyConfigResponse
ReadS [GetProvisionedConcurrencyConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetProvisionedConcurrencyConfigResponse]
$creadListPrec :: ReadPrec [GetProvisionedConcurrencyConfigResponse]
readPrec :: ReadPrec GetProvisionedConcurrencyConfigResponse
$creadPrec :: ReadPrec GetProvisionedConcurrencyConfigResponse
readList :: ReadS [GetProvisionedConcurrencyConfigResponse]
$creadList :: ReadS [GetProvisionedConcurrencyConfigResponse]
readsPrec :: Int -> ReadS GetProvisionedConcurrencyConfigResponse
$creadsPrec :: Int -> ReadS GetProvisionedConcurrencyConfigResponse
Prelude.Read, Int -> GetProvisionedConcurrencyConfigResponse -> ShowS
[GetProvisionedConcurrencyConfigResponse] -> ShowS
GetProvisionedConcurrencyConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetProvisionedConcurrencyConfigResponse] -> ShowS
$cshowList :: [GetProvisionedConcurrencyConfigResponse] -> ShowS
show :: GetProvisionedConcurrencyConfigResponse -> String
$cshow :: GetProvisionedConcurrencyConfigResponse -> String
showsPrec :: Int -> GetProvisionedConcurrencyConfigResponse -> ShowS
$cshowsPrec :: Int -> GetProvisionedConcurrencyConfigResponse -> ShowS
Prelude.Show, forall x.
Rep GetProvisionedConcurrencyConfigResponse x
-> GetProvisionedConcurrencyConfigResponse
forall x.
GetProvisionedConcurrencyConfigResponse
-> Rep GetProvisionedConcurrencyConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetProvisionedConcurrencyConfigResponse x
-> GetProvisionedConcurrencyConfigResponse
$cfrom :: forall x.
GetProvisionedConcurrencyConfigResponse
-> Rep GetProvisionedConcurrencyConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetProvisionedConcurrencyConfigResponse' 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:
--
-- 'allocatedProvisionedConcurrentExecutions', 'getProvisionedConcurrencyConfigResponse_allocatedProvisionedConcurrentExecutions' - The amount of provisioned concurrency allocated. When a weighted alias
-- is used during linear and canary deployments, this value fluctuates
-- depending on the amount of concurrency that is provisioned for the
-- function versions.
--
-- 'availableProvisionedConcurrentExecutions', 'getProvisionedConcurrencyConfigResponse_availableProvisionedConcurrentExecutions' - The amount of provisioned concurrency available.
--
-- 'lastModified', 'getProvisionedConcurrencyConfigResponse_lastModified' - The date and time that a user last updated the configuration, in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601 format>.
--
-- 'requestedProvisionedConcurrentExecutions', 'getProvisionedConcurrencyConfigResponse_requestedProvisionedConcurrentExecutions' - The amount of provisioned concurrency requested.
--
-- 'status', 'getProvisionedConcurrencyConfigResponse_status' - The status of the allocation process.
--
-- 'statusReason', 'getProvisionedConcurrencyConfigResponse_statusReason' - For failed allocations, the reason that provisioned concurrency could
-- not be allocated.
--
-- 'httpStatus', 'getProvisionedConcurrencyConfigResponse_httpStatus' - The response's http status code.
newGetProvisionedConcurrencyConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetProvisionedConcurrencyConfigResponse
newGetProvisionedConcurrencyConfigResponse :: Int -> GetProvisionedConcurrencyConfigResponse
newGetProvisionedConcurrencyConfigResponse
  Int
pHttpStatus_ =
    GetProvisionedConcurrencyConfigResponse'
      { $sel:allocatedProvisionedConcurrentExecutions:GetProvisionedConcurrencyConfigResponse' :: Maybe Natural
allocatedProvisionedConcurrentExecutions =
          forall a. Maybe a
Prelude.Nothing,
        $sel:availableProvisionedConcurrentExecutions:GetProvisionedConcurrencyConfigResponse' :: Maybe Natural
availableProvisionedConcurrentExecutions =
          forall a. Maybe a
Prelude.Nothing,
        $sel:lastModified:GetProvisionedConcurrencyConfigResponse' :: Maybe Text
lastModified = forall a. Maybe a
Prelude.Nothing,
        $sel:requestedProvisionedConcurrentExecutions:GetProvisionedConcurrencyConfigResponse' :: Maybe Natural
requestedProvisionedConcurrentExecutions =
          forall a. Maybe a
Prelude.Nothing,
        $sel:status:GetProvisionedConcurrencyConfigResponse' :: Maybe ProvisionedConcurrencyStatusEnum
status = forall a. Maybe a
Prelude.Nothing,
        $sel:statusReason:GetProvisionedConcurrencyConfigResponse' :: Maybe Text
statusReason = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetProvisionedConcurrencyConfigResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The amount of provisioned concurrency allocated. When a weighted alias
-- is used during linear and canary deployments, this value fluctuates
-- depending on the amount of concurrency that is provisioned for the
-- function versions.
getProvisionedConcurrencyConfigResponse_allocatedProvisionedConcurrentExecutions :: Lens.Lens' GetProvisionedConcurrencyConfigResponse (Prelude.Maybe Prelude.Natural)
getProvisionedConcurrencyConfigResponse_allocatedProvisionedConcurrentExecutions :: Lens' GetProvisionedConcurrencyConfigResponse (Maybe Natural)
getProvisionedConcurrencyConfigResponse_allocatedProvisionedConcurrentExecutions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedConcurrencyConfigResponse' {Maybe Natural
allocatedProvisionedConcurrentExecutions :: Maybe Natural
$sel:allocatedProvisionedConcurrentExecutions:GetProvisionedConcurrencyConfigResponse' :: GetProvisionedConcurrencyConfigResponse -> Maybe Natural
allocatedProvisionedConcurrentExecutions} -> Maybe Natural
allocatedProvisionedConcurrentExecutions) (\s :: GetProvisionedConcurrencyConfigResponse
s@GetProvisionedConcurrencyConfigResponse' {} Maybe Natural
a -> GetProvisionedConcurrencyConfigResponse
s {$sel:allocatedProvisionedConcurrentExecutions:GetProvisionedConcurrencyConfigResponse' :: Maybe Natural
allocatedProvisionedConcurrentExecutions = Maybe Natural
a} :: GetProvisionedConcurrencyConfigResponse)

-- | The amount of provisioned concurrency available.
getProvisionedConcurrencyConfigResponse_availableProvisionedConcurrentExecutions :: Lens.Lens' GetProvisionedConcurrencyConfigResponse (Prelude.Maybe Prelude.Natural)
getProvisionedConcurrencyConfigResponse_availableProvisionedConcurrentExecutions :: Lens' GetProvisionedConcurrencyConfigResponse (Maybe Natural)
getProvisionedConcurrencyConfigResponse_availableProvisionedConcurrentExecutions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedConcurrencyConfigResponse' {Maybe Natural
availableProvisionedConcurrentExecutions :: Maybe Natural
$sel:availableProvisionedConcurrentExecutions:GetProvisionedConcurrencyConfigResponse' :: GetProvisionedConcurrencyConfigResponse -> Maybe Natural
availableProvisionedConcurrentExecutions} -> Maybe Natural
availableProvisionedConcurrentExecutions) (\s :: GetProvisionedConcurrencyConfigResponse
s@GetProvisionedConcurrencyConfigResponse' {} Maybe Natural
a -> GetProvisionedConcurrencyConfigResponse
s {$sel:availableProvisionedConcurrentExecutions:GetProvisionedConcurrencyConfigResponse' :: Maybe Natural
availableProvisionedConcurrentExecutions = Maybe Natural
a} :: GetProvisionedConcurrencyConfigResponse)

-- | The date and time that a user last updated the configuration, in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601 format>.
getProvisionedConcurrencyConfigResponse_lastModified :: Lens.Lens' GetProvisionedConcurrencyConfigResponse (Prelude.Maybe Prelude.Text)
getProvisionedConcurrencyConfigResponse_lastModified :: Lens' GetProvisionedConcurrencyConfigResponse (Maybe Text)
getProvisionedConcurrencyConfigResponse_lastModified = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedConcurrencyConfigResponse' {Maybe Text
lastModified :: Maybe Text
$sel:lastModified:GetProvisionedConcurrencyConfigResponse' :: GetProvisionedConcurrencyConfigResponse -> Maybe Text
lastModified} -> Maybe Text
lastModified) (\s :: GetProvisionedConcurrencyConfigResponse
s@GetProvisionedConcurrencyConfigResponse' {} Maybe Text
a -> GetProvisionedConcurrencyConfigResponse
s {$sel:lastModified:GetProvisionedConcurrencyConfigResponse' :: Maybe Text
lastModified = Maybe Text
a} :: GetProvisionedConcurrencyConfigResponse)

-- | The amount of provisioned concurrency requested.
getProvisionedConcurrencyConfigResponse_requestedProvisionedConcurrentExecutions :: Lens.Lens' GetProvisionedConcurrencyConfigResponse (Prelude.Maybe Prelude.Natural)
getProvisionedConcurrencyConfigResponse_requestedProvisionedConcurrentExecutions :: Lens' GetProvisionedConcurrencyConfigResponse (Maybe Natural)
getProvisionedConcurrencyConfigResponse_requestedProvisionedConcurrentExecutions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedConcurrencyConfigResponse' {Maybe Natural
requestedProvisionedConcurrentExecutions :: Maybe Natural
$sel:requestedProvisionedConcurrentExecutions:GetProvisionedConcurrencyConfigResponse' :: GetProvisionedConcurrencyConfigResponse -> Maybe Natural
requestedProvisionedConcurrentExecutions} -> Maybe Natural
requestedProvisionedConcurrentExecutions) (\s :: GetProvisionedConcurrencyConfigResponse
s@GetProvisionedConcurrencyConfigResponse' {} Maybe Natural
a -> GetProvisionedConcurrencyConfigResponse
s {$sel:requestedProvisionedConcurrentExecutions:GetProvisionedConcurrencyConfigResponse' :: Maybe Natural
requestedProvisionedConcurrentExecutions = Maybe Natural
a} :: GetProvisionedConcurrencyConfigResponse)

-- | The status of the allocation process.
getProvisionedConcurrencyConfigResponse_status :: Lens.Lens' GetProvisionedConcurrencyConfigResponse (Prelude.Maybe ProvisionedConcurrencyStatusEnum)
getProvisionedConcurrencyConfigResponse_status :: Lens'
  GetProvisionedConcurrencyConfigResponse
  (Maybe ProvisionedConcurrencyStatusEnum)
getProvisionedConcurrencyConfigResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedConcurrencyConfigResponse' {Maybe ProvisionedConcurrencyStatusEnum
status :: Maybe ProvisionedConcurrencyStatusEnum
$sel:status:GetProvisionedConcurrencyConfigResponse' :: GetProvisionedConcurrencyConfigResponse
-> Maybe ProvisionedConcurrencyStatusEnum
status} -> Maybe ProvisionedConcurrencyStatusEnum
status) (\s :: GetProvisionedConcurrencyConfigResponse
s@GetProvisionedConcurrencyConfigResponse' {} Maybe ProvisionedConcurrencyStatusEnum
a -> GetProvisionedConcurrencyConfigResponse
s {$sel:status:GetProvisionedConcurrencyConfigResponse' :: Maybe ProvisionedConcurrencyStatusEnum
status = Maybe ProvisionedConcurrencyStatusEnum
a} :: GetProvisionedConcurrencyConfigResponse)

-- | For failed allocations, the reason that provisioned concurrency could
-- not be allocated.
getProvisionedConcurrencyConfigResponse_statusReason :: Lens.Lens' GetProvisionedConcurrencyConfigResponse (Prelude.Maybe Prelude.Text)
getProvisionedConcurrencyConfigResponse_statusReason :: Lens' GetProvisionedConcurrencyConfigResponse (Maybe Text)
getProvisionedConcurrencyConfigResponse_statusReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetProvisionedConcurrencyConfigResponse' {Maybe Text
statusReason :: Maybe Text
$sel:statusReason:GetProvisionedConcurrencyConfigResponse' :: GetProvisionedConcurrencyConfigResponse -> Maybe Text
statusReason} -> Maybe Text
statusReason) (\s :: GetProvisionedConcurrencyConfigResponse
s@GetProvisionedConcurrencyConfigResponse' {} Maybe Text
a -> GetProvisionedConcurrencyConfigResponse
s {$sel:statusReason:GetProvisionedConcurrencyConfigResponse' :: Maybe Text
statusReason = Maybe Text
a} :: GetProvisionedConcurrencyConfigResponse)

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

instance
  Prelude.NFData
    GetProvisionedConcurrencyConfigResponse
  where
  rnf :: GetProvisionedConcurrencyConfigResponse -> ()
rnf GetProvisionedConcurrencyConfigResponse' {Int
Maybe Natural
Maybe Text
Maybe ProvisionedConcurrencyStatusEnum
httpStatus :: Int
statusReason :: Maybe Text
status :: Maybe ProvisionedConcurrencyStatusEnum
requestedProvisionedConcurrentExecutions :: Maybe Natural
lastModified :: Maybe Text
availableProvisionedConcurrentExecutions :: Maybe Natural
allocatedProvisionedConcurrentExecutions :: Maybe Natural
$sel:httpStatus:GetProvisionedConcurrencyConfigResponse' :: GetProvisionedConcurrencyConfigResponse -> Int
$sel:statusReason:GetProvisionedConcurrencyConfigResponse' :: GetProvisionedConcurrencyConfigResponse -> Maybe Text
$sel:status:GetProvisionedConcurrencyConfigResponse' :: GetProvisionedConcurrencyConfigResponse
-> Maybe ProvisionedConcurrencyStatusEnum
$sel:requestedProvisionedConcurrentExecutions:GetProvisionedConcurrencyConfigResponse' :: GetProvisionedConcurrencyConfigResponse -> Maybe Natural
$sel:lastModified:GetProvisionedConcurrencyConfigResponse' :: GetProvisionedConcurrencyConfigResponse -> Maybe Text
$sel:availableProvisionedConcurrentExecutions:GetProvisionedConcurrencyConfigResponse' :: GetProvisionedConcurrencyConfigResponse -> Maybe Natural
$sel:allocatedProvisionedConcurrentExecutions:GetProvisionedConcurrencyConfigResponse' :: GetProvisionedConcurrencyConfigResponse -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf
      Maybe Natural
allocatedProvisionedConcurrentExecutions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
availableProvisionedConcurrentExecutions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lastModified
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
requestedProvisionedConcurrentExecutions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProvisionedConcurrencyStatusEnum
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus