{-# 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.EMRServerless.CreateApplication
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an application.
module Amazonka.EMRServerless.CreateApplication
  ( -- * Creating a Request
    CreateApplication (..),
    newCreateApplication,

    -- * Request Lenses
    createApplication_architecture,
    createApplication_autoStartConfiguration,
    createApplication_autoStopConfiguration,
    createApplication_imageConfiguration,
    createApplication_initialCapacity,
    createApplication_maximumCapacity,
    createApplication_name,
    createApplication_networkConfiguration,
    createApplication_tags,
    createApplication_workerTypeSpecifications,
    createApplication_releaseLabel,
    createApplication_type,
    createApplication_clientToken,

    -- * Destructuring the Response
    CreateApplicationResponse (..),
    newCreateApplicationResponse,

    -- * Response Lenses
    createApplicationResponse_name,
    createApplicationResponse_httpStatus,
    createApplicationResponse_applicationId,
    createApplicationResponse_arn,
  )
where

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

-- | /See:/ 'newCreateApplication' smart constructor.
data CreateApplication = CreateApplication'
  { -- | The CPU architecture of an application.
    CreateApplication -> Maybe Architecture
architecture :: Prelude.Maybe Architecture,
    -- | The configuration for an application to automatically start on job
    -- submission.
    CreateApplication -> Maybe AutoStartConfig
autoStartConfiguration :: Prelude.Maybe AutoStartConfig,
    -- | The configuration for an application to automatically stop after a
    -- certain amount of time being idle.
    CreateApplication -> Maybe AutoStopConfig
autoStopConfiguration :: Prelude.Maybe AutoStopConfig,
    -- | The image configuration for all worker types. You can either set this
    -- parameter or @imageConfiguration@ for each worker type in
    -- @workerTypeSpecifications@.
    CreateApplication -> Maybe ImageConfigurationInput
imageConfiguration :: Prelude.Maybe ImageConfigurationInput,
    -- | The capacity to initialize when the application is created.
    CreateApplication -> Maybe (HashMap Text InitialCapacityConfig)
initialCapacity :: Prelude.Maybe (Prelude.HashMap Prelude.Text InitialCapacityConfig),
    -- | The maximum capacity to allocate when the application is created. This
    -- is cumulative across all workers at any given point in time, not just
    -- when an application is created. No new resources will be created once
    -- any one of the defined limits is hit.
    CreateApplication -> Maybe MaximumAllowedResources
maximumCapacity :: Prelude.Maybe MaximumAllowedResources,
    -- | The name of the application.
    CreateApplication -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The network configuration for customer VPC connectivity.
    CreateApplication -> Maybe NetworkConfiguration
networkConfiguration :: Prelude.Maybe NetworkConfiguration,
    -- | The tags assigned to the application.
    CreateApplication -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The key-value pairs that specify worker type to
    -- @WorkerTypeSpecificationInput@. This parameter must contain all valid
    -- worker types for a Spark or Hive application. Valid worker types include
    -- @Driver@ and @Executor@ for Spark applications and @HiveDriver@ and
    -- @TezTask@ for Hive applications. You can either set image details in
    -- this parameter for each worker type, or in @imageConfiguration@ for all
    -- worker types.
    CreateApplication
-> Maybe (HashMap Text WorkerTypeSpecificationInput)
workerTypeSpecifications :: Prelude.Maybe (Prelude.HashMap Prelude.Text WorkerTypeSpecificationInput),
    -- | The EMR release associated with the application.
    CreateApplication -> Text
releaseLabel :: Prelude.Text,
    -- | The type of application you want to start, such as Spark or Hive.
    CreateApplication -> Text
type' :: Prelude.Text,
    -- | The client idempotency token of the application to create. Its value
    -- must be unique for each request.
    CreateApplication -> Text
clientToken :: Prelude.Text
  }
  deriving (CreateApplication -> CreateApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApplication -> CreateApplication -> Bool
$c/= :: CreateApplication -> CreateApplication -> Bool
== :: CreateApplication -> CreateApplication -> Bool
$c== :: CreateApplication -> CreateApplication -> Bool
Prelude.Eq, ReadPrec [CreateApplication]
ReadPrec CreateApplication
Int -> ReadS CreateApplication
ReadS [CreateApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApplication]
$creadListPrec :: ReadPrec [CreateApplication]
readPrec :: ReadPrec CreateApplication
$creadPrec :: ReadPrec CreateApplication
readList :: ReadS [CreateApplication]
$creadList :: ReadS [CreateApplication]
readsPrec :: Int -> ReadS CreateApplication
$creadsPrec :: Int -> ReadS CreateApplication
Prelude.Read, Int -> CreateApplication -> ShowS
[CreateApplication] -> ShowS
CreateApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApplication] -> ShowS
$cshowList :: [CreateApplication] -> ShowS
show :: CreateApplication -> String
$cshow :: CreateApplication -> String
showsPrec :: Int -> CreateApplication -> ShowS
$cshowsPrec :: Int -> CreateApplication -> ShowS
Prelude.Show, forall x. Rep CreateApplication x -> CreateApplication
forall x. CreateApplication -> Rep CreateApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateApplication x -> CreateApplication
$cfrom :: forall x. CreateApplication -> Rep CreateApplication x
Prelude.Generic)

-- |
-- Create a value of 'CreateApplication' 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:
--
-- 'architecture', 'createApplication_architecture' - The CPU architecture of an application.
--
-- 'autoStartConfiguration', 'createApplication_autoStartConfiguration' - The configuration for an application to automatically start on job
-- submission.
--
-- 'autoStopConfiguration', 'createApplication_autoStopConfiguration' - The configuration for an application to automatically stop after a
-- certain amount of time being idle.
--
-- 'imageConfiguration', 'createApplication_imageConfiguration' - The image configuration for all worker types. You can either set this
-- parameter or @imageConfiguration@ for each worker type in
-- @workerTypeSpecifications@.
--
-- 'initialCapacity', 'createApplication_initialCapacity' - The capacity to initialize when the application is created.
--
-- 'maximumCapacity', 'createApplication_maximumCapacity' - The maximum capacity to allocate when the application is created. This
-- is cumulative across all workers at any given point in time, not just
-- when an application is created. No new resources will be created once
-- any one of the defined limits is hit.
--
-- 'name', 'createApplication_name' - The name of the application.
--
-- 'networkConfiguration', 'createApplication_networkConfiguration' - The network configuration for customer VPC connectivity.
--
-- 'tags', 'createApplication_tags' - The tags assigned to the application.
--
-- 'workerTypeSpecifications', 'createApplication_workerTypeSpecifications' - The key-value pairs that specify worker type to
-- @WorkerTypeSpecificationInput@. This parameter must contain all valid
-- worker types for a Spark or Hive application. Valid worker types include
-- @Driver@ and @Executor@ for Spark applications and @HiveDriver@ and
-- @TezTask@ for Hive applications. You can either set image details in
-- this parameter for each worker type, or in @imageConfiguration@ for all
-- worker types.
--
-- 'releaseLabel', 'createApplication_releaseLabel' - The EMR release associated with the application.
--
-- 'type'', 'createApplication_type' - The type of application you want to start, such as Spark or Hive.
--
-- 'clientToken', 'createApplication_clientToken' - The client idempotency token of the application to create. Its value
-- must be unique for each request.
newCreateApplication ::
  -- | 'releaseLabel'
  Prelude.Text ->
  -- | 'type''
  Prelude.Text ->
  -- | 'clientToken'
  Prelude.Text ->
  CreateApplication
newCreateApplication :: Text -> Text -> Text -> CreateApplication
newCreateApplication
  Text
pReleaseLabel_
  Text
pType_
  Text
pClientToken_ =
    CreateApplication'
      { $sel:architecture:CreateApplication' :: Maybe Architecture
architecture = forall a. Maybe a
Prelude.Nothing,
        $sel:autoStartConfiguration:CreateApplication' :: Maybe AutoStartConfig
autoStartConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:autoStopConfiguration:CreateApplication' :: Maybe AutoStopConfig
autoStopConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:imageConfiguration:CreateApplication' :: Maybe ImageConfigurationInput
imageConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:initialCapacity:CreateApplication' :: Maybe (HashMap Text InitialCapacityConfig)
initialCapacity = forall a. Maybe a
Prelude.Nothing,
        $sel:maximumCapacity:CreateApplication' :: Maybe MaximumAllowedResources
maximumCapacity = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateApplication' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
        $sel:networkConfiguration:CreateApplication' :: Maybe NetworkConfiguration
networkConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateApplication' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:workerTypeSpecifications:CreateApplication' :: Maybe (HashMap Text WorkerTypeSpecificationInput)
workerTypeSpecifications = forall a. Maybe a
Prelude.Nothing,
        $sel:releaseLabel:CreateApplication' :: Text
releaseLabel = Text
pReleaseLabel_,
        $sel:type':CreateApplication' :: Text
type' = Text
pType_,
        $sel:clientToken:CreateApplication' :: Text
clientToken = Text
pClientToken_
      }

-- | The CPU architecture of an application.
createApplication_architecture :: Lens.Lens' CreateApplication (Prelude.Maybe Architecture)
createApplication_architecture :: Lens' CreateApplication (Maybe Architecture)
createApplication_architecture = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Architecture
architecture :: Maybe Architecture
$sel:architecture:CreateApplication' :: CreateApplication -> Maybe Architecture
architecture} -> Maybe Architecture
architecture) (\s :: CreateApplication
s@CreateApplication' {} Maybe Architecture
a -> CreateApplication
s {$sel:architecture:CreateApplication' :: Maybe Architecture
architecture = Maybe Architecture
a} :: CreateApplication)

-- | The configuration for an application to automatically start on job
-- submission.
createApplication_autoStartConfiguration :: Lens.Lens' CreateApplication (Prelude.Maybe AutoStartConfig)
createApplication_autoStartConfiguration :: Lens' CreateApplication (Maybe AutoStartConfig)
createApplication_autoStartConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe AutoStartConfig
autoStartConfiguration :: Maybe AutoStartConfig
$sel:autoStartConfiguration:CreateApplication' :: CreateApplication -> Maybe AutoStartConfig
autoStartConfiguration} -> Maybe AutoStartConfig
autoStartConfiguration) (\s :: CreateApplication
s@CreateApplication' {} Maybe AutoStartConfig
a -> CreateApplication
s {$sel:autoStartConfiguration:CreateApplication' :: Maybe AutoStartConfig
autoStartConfiguration = Maybe AutoStartConfig
a} :: CreateApplication)

-- | The configuration for an application to automatically stop after a
-- certain amount of time being idle.
createApplication_autoStopConfiguration :: Lens.Lens' CreateApplication (Prelude.Maybe AutoStopConfig)
createApplication_autoStopConfiguration :: Lens' CreateApplication (Maybe AutoStopConfig)
createApplication_autoStopConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe AutoStopConfig
autoStopConfiguration :: Maybe AutoStopConfig
$sel:autoStopConfiguration:CreateApplication' :: CreateApplication -> Maybe AutoStopConfig
autoStopConfiguration} -> Maybe AutoStopConfig
autoStopConfiguration) (\s :: CreateApplication
s@CreateApplication' {} Maybe AutoStopConfig
a -> CreateApplication
s {$sel:autoStopConfiguration:CreateApplication' :: Maybe AutoStopConfig
autoStopConfiguration = Maybe AutoStopConfig
a} :: CreateApplication)

-- | The image configuration for all worker types. You can either set this
-- parameter or @imageConfiguration@ for each worker type in
-- @workerTypeSpecifications@.
createApplication_imageConfiguration :: Lens.Lens' CreateApplication (Prelude.Maybe ImageConfigurationInput)
createApplication_imageConfiguration :: Lens' CreateApplication (Maybe ImageConfigurationInput)
createApplication_imageConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe ImageConfigurationInput
imageConfiguration :: Maybe ImageConfigurationInput
$sel:imageConfiguration:CreateApplication' :: CreateApplication -> Maybe ImageConfigurationInput
imageConfiguration} -> Maybe ImageConfigurationInput
imageConfiguration) (\s :: CreateApplication
s@CreateApplication' {} Maybe ImageConfigurationInput
a -> CreateApplication
s {$sel:imageConfiguration:CreateApplication' :: Maybe ImageConfigurationInput
imageConfiguration = Maybe ImageConfigurationInput
a} :: CreateApplication)

-- | The capacity to initialize when the application is created.
createApplication_initialCapacity :: Lens.Lens' CreateApplication (Prelude.Maybe (Prelude.HashMap Prelude.Text InitialCapacityConfig))
createApplication_initialCapacity :: Lens'
  CreateApplication (Maybe (HashMap Text InitialCapacityConfig))
createApplication_initialCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe (HashMap Text InitialCapacityConfig)
initialCapacity :: Maybe (HashMap Text InitialCapacityConfig)
$sel:initialCapacity:CreateApplication' :: CreateApplication -> Maybe (HashMap Text InitialCapacityConfig)
initialCapacity} -> Maybe (HashMap Text InitialCapacityConfig)
initialCapacity) (\s :: CreateApplication
s@CreateApplication' {} Maybe (HashMap Text InitialCapacityConfig)
a -> CreateApplication
s {$sel:initialCapacity:CreateApplication' :: Maybe (HashMap Text InitialCapacityConfig)
initialCapacity = Maybe (HashMap Text InitialCapacityConfig)
a} :: CreateApplication) 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

-- | The maximum capacity to allocate when the application is created. This
-- is cumulative across all workers at any given point in time, not just
-- when an application is created. No new resources will be created once
-- any one of the defined limits is hit.
createApplication_maximumCapacity :: Lens.Lens' CreateApplication (Prelude.Maybe MaximumAllowedResources)
createApplication_maximumCapacity :: Lens' CreateApplication (Maybe MaximumAllowedResources)
createApplication_maximumCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe MaximumAllowedResources
maximumCapacity :: Maybe MaximumAllowedResources
$sel:maximumCapacity:CreateApplication' :: CreateApplication -> Maybe MaximumAllowedResources
maximumCapacity} -> Maybe MaximumAllowedResources
maximumCapacity) (\s :: CreateApplication
s@CreateApplication' {} Maybe MaximumAllowedResources
a -> CreateApplication
s {$sel:maximumCapacity:CreateApplication' :: Maybe MaximumAllowedResources
maximumCapacity = Maybe MaximumAllowedResources
a} :: CreateApplication)

-- | The name of the application.
createApplication_name :: Lens.Lens' CreateApplication (Prelude.Maybe Prelude.Text)
createApplication_name :: Lens' CreateApplication (Maybe Text)
createApplication_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe Text
name :: Maybe Text
$sel:name:CreateApplication' :: CreateApplication -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateApplication
s@CreateApplication' {} Maybe Text
a -> CreateApplication
s {$sel:name:CreateApplication' :: Maybe Text
name = Maybe Text
a} :: CreateApplication)

-- | The network configuration for customer VPC connectivity.
createApplication_networkConfiguration :: Lens.Lens' CreateApplication (Prelude.Maybe NetworkConfiguration)
createApplication_networkConfiguration :: Lens' CreateApplication (Maybe NetworkConfiguration)
createApplication_networkConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe NetworkConfiguration
networkConfiguration :: Maybe NetworkConfiguration
$sel:networkConfiguration:CreateApplication' :: CreateApplication -> Maybe NetworkConfiguration
networkConfiguration} -> Maybe NetworkConfiguration
networkConfiguration) (\s :: CreateApplication
s@CreateApplication' {} Maybe NetworkConfiguration
a -> CreateApplication
s {$sel:networkConfiguration:CreateApplication' :: Maybe NetworkConfiguration
networkConfiguration = Maybe NetworkConfiguration
a} :: CreateApplication)

-- | The tags assigned to the application.
createApplication_tags :: Lens.Lens' CreateApplication (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createApplication_tags :: Lens' CreateApplication (Maybe (HashMap Text Text))
createApplication_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateApplication' :: CreateApplication -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateApplication
s@CreateApplication' {} Maybe (HashMap Text Text)
a -> CreateApplication
s {$sel:tags:CreateApplication' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateApplication) 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

-- | The key-value pairs that specify worker type to
-- @WorkerTypeSpecificationInput@. This parameter must contain all valid
-- worker types for a Spark or Hive application. Valid worker types include
-- @Driver@ and @Executor@ for Spark applications and @HiveDriver@ and
-- @TezTask@ for Hive applications. You can either set image details in
-- this parameter for each worker type, or in @imageConfiguration@ for all
-- worker types.
createApplication_workerTypeSpecifications :: Lens.Lens' CreateApplication (Prelude.Maybe (Prelude.HashMap Prelude.Text WorkerTypeSpecificationInput))
createApplication_workerTypeSpecifications :: Lens'
  CreateApplication
  (Maybe (HashMap Text WorkerTypeSpecificationInput))
createApplication_workerTypeSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe (HashMap Text WorkerTypeSpecificationInput)
workerTypeSpecifications :: Maybe (HashMap Text WorkerTypeSpecificationInput)
$sel:workerTypeSpecifications:CreateApplication' :: CreateApplication
-> Maybe (HashMap Text WorkerTypeSpecificationInput)
workerTypeSpecifications} -> Maybe (HashMap Text WorkerTypeSpecificationInput)
workerTypeSpecifications) (\s :: CreateApplication
s@CreateApplication' {} Maybe (HashMap Text WorkerTypeSpecificationInput)
a -> CreateApplication
s {$sel:workerTypeSpecifications:CreateApplication' :: Maybe (HashMap Text WorkerTypeSpecificationInput)
workerTypeSpecifications = Maybe (HashMap Text WorkerTypeSpecificationInput)
a} :: CreateApplication) 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

-- | The EMR release associated with the application.
createApplication_releaseLabel :: Lens.Lens' CreateApplication Prelude.Text
createApplication_releaseLabel :: Lens' CreateApplication Text
createApplication_releaseLabel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Text
releaseLabel :: Text
$sel:releaseLabel:CreateApplication' :: CreateApplication -> Text
releaseLabel} -> Text
releaseLabel) (\s :: CreateApplication
s@CreateApplication' {} Text
a -> CreateApplication
s {$sel:releaseLabel:CreateApplication' :: Text
releaseLabel = Text
a} :: CreateApplication)

-- | The type of application you want to start, such as Spark or Hive.
createApplication_type :: Lens.Lens' CreateApplication Prelude.Text
createApplication_type :: Lens' CreateApplication Text
createApplication_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Text
type' :: Text
$sel:type':CreateApplication' :: CreateApplication -> Text
type'} -> Text
type') (\s :: CreateApplication
s@CreateApplication' {} Text
a -> CreateApplication
s {$sel:type':CreateApplication' :: Text
type' = Text
a} :: CreateApplication)

-- | The client idempotency token of the application to create. Its value
-- must be unique for each request.
createApplication_clientToken :: Lens.Lens' CreateApplication Prelude.Text
createApplication_clientToken :: Lens' CreateApplication Text
createApplication_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Text
clientToken :: Text
$sel:clientToken:CreateApplication' :: CreateApplication -> Text
clientToken} -> Text
clientToken) (\s :: CreateApplication
s@CreateApplication' {} Text
a -> CreateApplication
s {$sel:clientToken:CreateApplication' :: Text
clientToken = Text
a} :: CreateApplication)

instance Core.AWSRequest CreateApplication where
  type
    AWSResponse CreateApplication =
      CreateApplicationResponse
  request :: (Service -> Service)
-> CreateApplication -> Request CreateApplication
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 CreateApplication
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateApplication)))
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 -> Text -> Text -> CreateApplicationResponse
CreateApplicationResponse'
            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
"name")
            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))
            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
"applicationId")
            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
"arn")
      )

instance Prelude.Hashable CreateApplication where
  hashWithSalt :: Int -> CreateApplication -> Int
hashWithSalt Int
_salt CreateApplication' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text InitialCapacityConfig)
Maybe (HashMap Text WorkerTypeSpecificationInput)
Maybe Architecture
Maybe AutoStartConfig
Maybe AutoStopConfig
Maybe ImageConfigurationInput
Maybe MaximumAllowedResources
Maybe NetworkConfiguration
Text
clientToken :: Text
type' :: Text
releaseLabel :: Text
workerTypeSpecifications :: Maybe (HashMap Text WorkerTypeSpecificationInput)
tags :: Maybe (HashMap Text Text)
networkConfiguration :: Maybe NetworkConfiguration
name :: Maybe Text
maximumCapacity :: Maybe MaximumAllowedResources
initialCapacity :: Maybe (HashMap Text InitialCapacityConfig)
imageConfiguration :: Maybe ImageConfigurationInput
autoStopConfiguration :: Maybe AutoStopConfig
autoStartConfiguration :: Maybe AutoStartConfig
architecture :: Maybe Architecture
$sel:clientToken:CreateApplication' :: CreateApplication -> Text
$sel:type':CreateApplication' :: CreateApplication -> Text
$sel:releaseLabel:CreateApplication' :: CreateApplication -> Text
$sel:workerTypeSpecifications:CreateApplication' :: CreateApplication
-> Maybe (HashMap Text WorkerTypeSpecificationInput)
$sel:tags:CreateApplication' :: CreateApplication -> Maybe (HashMap Text Text)
$sel:networkConfiguration:CreateApplication' :: CreateApplication -> Maybe NetworkConfiguration
$sel:name:CreateApplication' :: CreateApplication -> Maybe Text
$sel:maximumCapacity:CreateApplication' :: CreateApplication -> Maybe MaximumAllowedResources
$sel:initialCapacity:CreateApplication' :: CreateApplication -> Maybe (HashMap Text InitialCapacityConfig)
$sel:imageConfiguration:CreateApplication' :: CreateApplication -> Maybe ImageConfigurationInput
$sel:autoStopConfiguration:CreateApplication' :: CreateApplication -> Maybe AutoStopConfig
$sel:autoStartConfiguration:CreateApplication' :: CreateApplication -> Maybe AutoStartConfig
$sel:architecture:CreateApplication' :: CreateApplication -> Maybe Architecture
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Architecture
architecture
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoStartConfig
autoStartConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoStopConfig
autoStopConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ImageConfigurationInput
imageConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text InitialCapacityConfig)
initialCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MaximumAllowedResources
maximumCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NetworkConfiguration
networkConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text WorkerTypeSpecificationInput)
workerTypeSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
releaseLabel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken

instance Prelude.NFData CreateApplication where
  rnf :: CreateApplication -> ()
rnf CreateApplication' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text InitialCapacityConfig)
Maybe (HashMap Text WorkerTypeSpecificationInput)
Maybe Architecture
Maybe AutoStartConfig
Maybe AutoStopConfig
Maybe ImageConfigurationInput
Maybe MaximumAllowedResources
Maybe NetworkConfiguration
Text
clientToken :: Text
type' :: Text
releaseLabel :: Text
workerTypeSpecifications :: Maybe (HashMap Text WorkerTypeSpecificationInput)
tags :: Maybe (HashMap Text Text)
networkConfiguration :: Maybe NetworkConfiguration
name :: Maybe Text
maximumCapacity :: Maybe MaximumAllowedResources
initialCapacity :: Maybe (HashMap Text InitialCapacityConfig)
imageConfiguration :: Maybe ImageConfigurationInput
autoStopConfiguration :: Maybe AutoStopConfig
autoStartConfiguration :: Maybe AutoStartConfig
architecture :: Maybe Architecture
$sel:clientToken:CreateApplication' :: CreateApplication -> Text
$sel:type':CreateApplication' :: CreateApplication -> Text
$sel:releaseLabel:CreateApplication' :: CreateApplication -> Text
$sel:workerTypeSpecifications:CreateApplication' :: CreateApplication
-> Maybe (HashMap Text WorkerTypeSpecificationInput)
$sel:tags:CreateApplication' :: CreateApplication -> Maybe (HashMap Text Text)
$sel:networkConfiguration:CreateApplication' :: CreateApplication -> Maybe NetworkConfiguration
$sel:name:CreateApplication' :: CreateApplication -> Maybe Text
$sel:maximumCapacity:CreateApplication' :: CreateApplication -> Maybe MaximumAllowedResources
$sel:initialCapacity:CreateApplication' :: CreateApplication -> Maybe (HashMap Text InitialCapacityConfig)
$sel:imageConfiguration:CreateApplication' :: CreateApplication -> Maybe ImageConfigurationInput
$sel:autoStopConfiguration:CreateApplication' :: CreateApplication -> Maybe AutoStopConfig
$sel:autoStartConfiguration:CreateApplication' :: CreateApplication -> Maybe AutoStartConfig
$sel:architecture:CreateApplication' :: CreateApplication -> Maybe Architecture
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Architecture
architecture
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoStartConfig
autoStartConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoStopConfig
autoStopConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ImageConfigurationInput
imageConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text InitialCapacityConfig)
initialCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MaximumAllowedResources
maximumCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NetworkConfiguration
networkConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text WorkerTypeSpecificationInput)
workerTypeSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
releaseLabel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken

instance Data.ToHeaders CreateApplication where
  toHeaders :: CreateApplication -> 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.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateApplication where
  toJSON :: CreateApplication -> Value
toJSON CreateApplication' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text InitialCapacityConfig)
Maybe (HashMap Text WorkerTypeSpecificationInput)
Maybe Architecture
Maybe AutoStartConfig
Maybe AutoStopConfig
Maybe ImageConfigurationInput
Maybe MaximumAllowedResources
Maybe NetworkConfiguration
Text
clientToken :: Text
type' :: Text
releaseLabel :: Text
workerTypeSpecifications :: Maybe (HashMap Text WorkerTypeSpecificationInput)
tags :: Maybe (HashMap Text Text)
networkConfiguration :: Maybe NetworkConfiguration
name :: Maybe Text
maximumCapacity :: Maybe MaximumAllowedResources
initialCapacity :: Maybe (HashMap Text InitialCapacityConfig)
imageConfiguration :: Maybe ImageConfigurationInput
autoStopConfiguration :: Maybe AutoStopConfig
autoStartConfiguration :: Maybe AutoStartConfig
architecture :: Maybe Architecture
$sel:clientToken:CreateApplication' :: CreateApplication -> Text
$sel:type':CreateApplication' :: CreateApplication -> Text
$sel:releaseLabel:CreateApplication' :: CreateApplication -> Text
$sel:workerTypeSpecifications:CreateApplication' :: CreateApplication
-> Maybe (HashMap Text WorkerTypeSpecificationInput)
$sel:tags:CreateApplication' :: CreateApplication -> Maybe (HashMap Text Text)
$sel:networkConfiguration:CreateApplication' :: CreateApplication -> Maybe NetworkConfiguration
$sel:name:CreateApplication' :: CreateApplication -> Maybe Text
$sel:maximumCapacity:CreateApplication' :: CreateApplication -> Maybe MaximumAllowedResources
$sel:initialCapacity:CreateApplication' :: CreateApplication -> Maybe (HashMap Text InitialCapacityConfig)
$sel:imageConfiguration:CreateApplication' :: CreateApplication -> Maybe ImageConfigurationInput
$sel:autoStopConfiguration:CreateApplication' :: CreateApplication -> Maybe AutoStopConfig
$sel:autoStartConfiguration:CreateApplication' :: CreateApplication -> Maybe AutoStartConfig
$sel:architecture:CreateApplication' :: CreateApplication -> Maybe Architecture
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"architecture" 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 Architecture
architecture,
            (Key
"autoStartConfiguration" 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 AutoStartConfig
autoStartConfiguration,
            (Key
"autoStopConfiguration" 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 AutoStopConfig
autoStopConfiguration,
            (Key
"imageConfiguration" 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 ImageConfigurationInput
imageConfiguration,
            (Key
"initialCapacity" 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 (HashMap Text InitialCapacityConfig)
initialCapacity,
            (Key
"maximumCapacity" 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 MaximumAllowedResources
maximumCapacity,
            (Key
"name" 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
name,
            (Key
"networkConfiguration" 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 NetworkConfiguration
networkConfiguration,
            (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 (HashMap Text Text)
tags,
            (Key
"workerTypeSpecifications" 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 (HashMap Text WorkerTypeSpecificationInput)
workerTypeSpecifications,
            forall a. a -> Maybe a
Prelude.Just (Key
"releaseLabel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
releaseLabel),
            forall a. a -> Maybe a
Prelude.Just (Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
type'),
            forall a. a -> Maybe a
Prelude.Just (Key
"clientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken)
          ]
      )

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

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

-- | /See:/ 'newCreateApplicationResponse' smart constructor.
data CreateApplicationResponse = CreateApplicationResponse'
  { -- | The output contains the name of the application.
    CreateApplicationResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateApplicationResponse -> Int
httpStatus :: Prelude.Int,
    -- | The output contains the application ID.
    CreateApplicationResponse -> Text
applicationId :: Prelude.Text,
    -- | The output contains the ARN of the application.
    CreateApplicationResponse -> Text
arn :: Prelude.Text
  }
  deriving (CreateApplicationResponse -> CreateApplicationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApplicationResponse -> CreateApplicationResponse -> Bool
$c/= :: CreateApplicationResponse -> CreateApplicationResponse -> Bool
== :: CreateApplicationResponse -> CreateApplicationResponse -> Bool
$c== :: CreateApplicationResponse -> CreateApplicationResponse -> Bool
Prelude.Eq, ReadPrec [CreateApplicationResponse]
ReadPrec CreateApplicationResponse
Int -> ReadS CreateApplicationResponse
ReadS [CreateApplicationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApplicationResponse]
$creadListPrec :: ReadPrec [CreateApplicationResponse]
readPrec :: ReadPrec CreateApplicationResponse
$creadPrec :: ReadPrec CreateApplicationResponse
readList :: ReadS [CreateApplicationResponse]
$creadList :: ReadS [CreateApplicationResponse]
readsPrec :: Int -> ReadS CreateApplicationResponse
$creadsPrec :: Int -> ReadS CreateApplicationResponse
Prelude.Read, Int -> CreateApplicationResponse -> ShowS
[CreateApplicationResponse] -> ShowS
CreateApplicationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApplicationResponse] -> ShowS
$cshowList :: [CreateApplicationResponse] -> ShowS
show :: CreateApplicationResponse -> String
$cshow :: CreateApplicationResponse -> String
showsPrec :: Int -> CreateApplicationResponse -> ShowS
$cshowsPrec :: Int -> CreateApplicationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateApplicationResponse x -> CreateApplicationResponse
forall x.
CreateApplicationResponse -> Rep CreateApplicationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateApplicationResponse x -> CreateApplicationResponse
$cfrom :: forall x.
CreateApplicationResponse -> Rep CreateApplicationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateApplicationResponse' 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:
--
-- 'name', 'createApplicationResponse_name' - The output contains the name of the application.
--
-- 'httpStatus', 'createApplicationResponse_httpStatus' - The response's http status code.
--
-- 'applicationId', 'createApplicationResponse_applicationId' - The output contains the application ID.
--
-- 'arn', 'createApplicationResponse_arn' - The output contains the ARN of the application.
newCreateApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'arn'
  Prelude.Text ->
  CreateApplicationResponse
newCreateApplicationResponse :: Int -> Text -> Text -> CreateApplicationResponse
newCreateApplicationResponse
  Int
pHttpStatus_
  Text
pApplicationId_
  Text
pArn_ =
    CreateApplicationResponse'
      { $sel:name:CreateApplicationResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateApplicationResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:applicationId:CreateApplicationResponse' :: Text
applicationId = Text
pApplicationId_,
        $sel:arn:CreateApplicationResponse' :: Text
arn = Text
pArn_
      }

-- | The output contains the name of the application.
createApplicationResponse_name :: Lens.Lens' CreateApplicationResponse (Prelude.Maybe Prelude.Text)
createApplicationResponse_name :: Lens' CreateApplicationResponse (Maybe Text)
createApplicationResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Maybe Text
name :: Maybe Text
$sel:name:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Maybe Text
a -> CreateApplicationResponse
s {$sel:name:CreateApplicationResponse' :: Maybe Text
name = Maybe Text
a} :: CreateApplicationResponse)

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

-- | The output contains the application ID.
createApplicationResponse_applicationId :: Lens.Lens' CreateApplicationResponse Prelude.Text
createApplicationResponse_applicationId :: Lens' CreateApplicationResponse Text
createApplicationResponse_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Text
applicationId :: Text
$sel:applicationId:CreateApplicationResponse' :: CreateApplicationResponse -> Text
applicationId} -> Text
applicationId) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Text
a -> CreateApplicationResponse
s {$sel:applicationId:CreateApplicationResponse' :: Text
applicationId = Text
a} :: CreateApplicationResponse)

-- | The output contains the ARN of the application.
createApplicationResponse_arn :: Lens.Lens' CreateApplicationResponse Prelude.Text
createApplicationResponse_arn :: Lens' CreateApplicationResponse Text
createApplicationResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationResponse' {Text
arn :: Text
$sel:arn:CreateApplicationResponse' :: CreateApplicationResponse -> Text
arn} -> Text
arn) (\s :: CreateApplicationResponse
s@CreateApplicationResponse' {} Text
a -> CreateApplicationResponse
s {$sel:arn:CreateApplicationResponse' :: Text
arn = Text
a} :: CreateApplicationResponse)

instance Prelude.NFData CreateApplicationResponse where
  rnf :: CreateApplicationResponse -> ()
rnf CreateApplicationResponse' {Int
Maybe Text
Text
arn :: Text
applicationId :: Text
httpStatus :: Int
name :: Maybe Text
$sel:arn:CreateApplicationResponse' :: CreateApplicationResponse -> Text
$sel:applicationId:CreateApplicationResponse' :: CreateApplicationResponse -> Text
$sel:httpStatus:CreateApplicationResponse' :: CreateApplicationResponse -> Int
$sel:name:CreateApplicationResponse' :: CreateApplicationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn