{-# 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.ElasticBeanstalk.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 that has one configuration template named
-- @default@ and no application versions.
module Amazonka.ElasticBeanstalk.CreateApplication
  ( -- * Creating a Request
    CreateApplication (..),
    newCreateApplication,

    -- * Request Lenses
    createApplication_description,
    createApplication_resourceLifecycleConfig,
    createApplication_tags,
    createApplication_applicationName,

    -- * Destructuring the Response
    ApplicationDescriptionMessage (..),
    newApplicationDescriptionMessage,

    -- * Response Lenses
    applicationDescriptionMessage_application,
  )
where

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

-- | Request to create an application.
--
-- /See:/ 'newCreateApplication' smart constructor.
data CreateApplication = CreateApplication'
  { -- | Your description of the application.
    CreateApplication -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Specifies an application resource lifecycle configuration to prevent
    -- your application from accumulating too many versions.
    CreateApplication -> Maybe ApplicationResourceLifecycleConfig
resourceLifecycleConfig :: Prelude.Maybe ApplicationResourceLifecycleConfig,
    -- | Specifies the tags applied to the application.
    --
    -- Elastic Beanstalk applies these tags only to the application.
    -- Environments that you create in the application don\'t inherit the tags.
    CreateApplication -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the application. Must be unique within your account.
    CreateApplication -> Text
applicationName :: 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:
--
-- 'description', 'createApplication_description' - Your description of the application.
--
-- 'resourceLifecycleConfig', 'createApplication_resourceLifecycleConfig' - Specifies an application resource lifecycle configuration to prevent
-- your application from accumulating too many versions.
--
-- 'tags', 'createApplication_tags' - Specifies the tags applied to the application.
--
-- Elastic Beanstalk applies these tags only to the application.
-- Environments that you create in the application don\'t inherit the tags.
--
-- 'applicationName', 'createApplication_applicationName' - The name of the application. Must be unique within your account.
newCreateApplication ::
  -- | 'applicationName'
  Prelude.Text ->
  CreateApplication
newCreateApplication :: Text -> CreateApplication
newCreateApplication Text
pApplicationName_ =
  CreateApplication'
    { $sel:description:CreateApplication' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceLifecycleConfig:CreateApplication' :: Maybe ApplicationResourceLifecycleConfig
resourceLifecycleConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateApplication' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:applicationName:CreateApplication' :: Text
applicationName = Text
pApplicationName_
    }

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

-- | Specifies an application resource lifecycle configuration to prevent
-- your application from accumulating too many versions.
createApplication_resourceLifecycleConfig :: Lens.Lens' CreateApplication (Prelude.Maybe ApplicationResourceLifecycleConfig)
createApplication_resourceLifecycleConfig :: Lens' CreateApplication (Maybe ApplicationResourceLifecycleConfig)
createApplication_resourceLifecycleConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe ApplicationResourceLifecycleConfig
resourceLifecycleConfig :: Maybe ApplicationResourceLifecycleConfig
$sel:resourceLifecycleConfig:CreateApplication' :: CreateApplication -> Maybe ApplicationResourceLifecycleConfig
resourceLifecycleConfig} -> Maybe ApplicationResourceLifecycleConfig
resourceLifecycleConfig) (\s :: CreateApplication
s@CreateApplication' {} Maybe ApplicationResourceLifecycleConfig
a -> CreateApplication
s {$sel:resourceLifecycleConfig:CreateApplication' :: Maybe ApplicationResourceLifecycleConfig
resourceLifecycleConfig = Maybe ApplicationResourceLifecycleConfig
a} :: CreateApplication)

-- | Specifies the tags applied to the application.
--
-- Elastic Beanstalk applies these tags only to the application.
-- Environments that you create in the application don\'t inherit the tags.
createApplication_tags :: Lens.Lens' CreateApplication (Prelude.Maybe [Tag])
createApplication_tags :: Lens' CreateApplication (Maybe [Tag])
createApplication_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateApplication' :: CreateApplication -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateApplication
s@CreateApplication' {} Maybe [Tag]
a -> CreateApplication
s {$sel:tags:CreateApplication' :: Maybe [Tag]
tags = Maybe [Tag]
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 name of the application. Must be unique within your account.
createApplication_applicationName :: Lens.Lens' CreateApplication Prelude.Text
createApplication_applicationName :: Lens' CreateApplication Text
createApplication_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplication' {Text
applicationName :: Text
$sel:applicationName:CreateApplication' :: CreateApplication -> Text
applicationName} -> Text
applicationName) (\s :: CreateApplication
s@CreateApplication' {} Text
a -> CreateApplication
s {$sel:applicationName:CreateApplication' :: Text
applicationName = Text
a} :: CreateApplication)

instance Core.AWSRequest CreateApplication where
  type
    AWSResponse CreateApplication =
      ApplicationDescriptionMessage
  request :: (Service -> Service)
-> CreateApplication -> Request CreateApplication
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (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 =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"CreateApplicationResult"
      (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance Prelude.Hashable CreateApplication where
  hashWithSalt :: Int -> CreateApplication -> Int
hashWithSalt Int
_salt CreateApplication' {Maybe [Tag]
Maybe Text
Maybe ApplicationResourceLifecycleConfig
Text
applicationName :: Text
tags :: Maybe [Tag]
resourceLifecycleConfig :: Maybe ApplicationResourceLifecycleConfig
description :: Maybe Text
$sel:applicationName:CreateApplication' :: CreateApplication -> Text
$sel:tags:CreateApplication' :: CreateApplication -> Maybe [Tag]
$sel:resourceLifecycleConfig:CreateApplication' :: CreateApplication -> Maybe ApplicationResourceLifecycleConfig
$sel:description:CreateApplication' :: CreateApplication -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ApplicationResourceLifecycleConfig
resourceLifecycleConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationName

instance Prelude.NFData CreateApplication where
  rnf :: CreateApplication -> ()
rnf CreateApplication' {Maybe [Tag]
Maybe Text
Maybe ApplicationResourceLifecycleConfig
Text
applicationName :: Text
tags :: Maybe [Tag]
resourceLifecycleConfig :: Maybe ApplicationResourceLifecycleConfig
description :: Maybe Text
$sel:applicationName:CreateApplication' :: CreateApplication -> Text
$sel:tags:CreateApplication' :: CreateApplication -> Maybe [Tag]
$sel:resourceLifecycleConfig:CreateApplication' :: CreateApplication -> Maybe ApplicationResourceLifecycleConfig
$sel:description:CreateApplication' :: CreateApplication -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ApplicationResourceLifecycleConfig
resourceLifecycleConfig
      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
applicationName

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

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

instance Data.ToQuery CreateApplication where
  toQuery :: CreateApplication -> QueryString
toQuery CreateApplication' {Maybe [Tag]
Maybe Text
Maybe ApplicationResourceLifecycleConfig
Text
applicationName :: Text
tags :: Maybe [Tag]
resourceLifecycleConfig :: Maybe ApplicationResourceLifecycleConfig
description :: Maybe Text
$sel:applicationName:CreateApplication' :: CreateApplication -> Text
$sel:tags:CreateApplication' :: CreateApplication -> Maybe [Tag]
$sel:resourceLifecycleConfig:CreateApplication' :: CreateApplication -> Maybe ApplicationResourceLifecycleConfig
$sel:description:CreateApplication' :: CreateApplication -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateApplication" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"ResourceLifecycleConfig"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ApplicationResourceLifecycleConfig
resourceLifecycleConfig,
        ByteString
"Tags"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"ApplicationName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
applicationName
      ]