{-# 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.CreateApplicationVersion
-- 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 version for the specified application. You can
-- create an application version from a source bundle in Amazon S3, a
-- commit in AWS CodeCommit, or the output of an AWS CodeBuild build as
-- follows:
--
-- Specify a commit in an AWS CodeCommit repository with
-- @SourceBuildInformation@.
--
-- Specify a build in an AWS CodeBuild with @SourceBuildInformation@ and
-- @BuildConfiguration@.
--
-- Specify a source bundle in S3 with @SourceBundle@
--
-- Omit both @SourceBuildInformation@ and @SourceBundle@ to use the default
-- sample application.
--
-- After you create an application version with a specified Amazon S3
-- bucket and key location, you can\'t change that Amazon S3 location. If
-- you change the Amazon S3 location, you receive an exception when you
-- attempt to launch an environment from the application version.
module Amazonka.ElasticBeanstalk.CreateApplicationVersion
  ( -- * Creating a Request
    CreateApplicationVersion (..),
    newCreateApplicationVersion,

    -- * Request Lenses
    createApplicationVersion_autoCreateApplication,
    createApplicationVersion_buildConfiguration,
    createApplicationVersion_description,
    createApplicationVersion_process,
    createApplicationVersion_sourceBuildInformation,
    createApplicationVersion_sourceBundle,
    createApplicationVersion_tags,
    createApplicationVersion_applicationName,
    createApplicationVersion_versionLabel,

    -- * Destructuring the Response
    ApplicationVersionDescriptionMessage (..),
    newApplicationVersionDescriptionMessage,

    -- * Response Lenses
    applicationVersionDescriptionMessage_applicationVersion,
  )
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

-- |
--
-- /See:/ 'newCreateApplicationVersion' smart constructor.
data CreateApplicationVersion = CreateApplicationVersion'
  { -- | Set to @true@ to create an application with the specified name if it
    -- doesn\'t already exist.
    CreateApplicationVersion -> Maybe Bool
autoCreateApplication :: Prelude.Maybe Prelude.Bool,
    -- | Settings for an AWS CodeBuild build.
    CreateApplicationVersion -> Maybe BuildConfiguration
buildConfiguration :: Prelude.Maybe BuildConfiguration,
    -- | A description of this application version.
    CreateApplicationVersion -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Pre-processes and validates the environment manifest (@env.yaml@) and
    -- configuration files (@*.config@ files in the @.ebextensions@ folder) in
    -- the source bundle. Validating configuration files can identify issues
    -- prior to deploying the application version to an environment.
    --
    -- You must turn processing on for application versions that you create
    -- using AWS CodeBuild or AWS CodeCommit. For application versions built
    -- from a source bundle in Amazon S3, processing is optional.
    --
    -- The @Process@ option validates Elastic Beanstalk configuration files. It
    -- doesn\'t validate your application\'s configuration files, like proxy
    -- server or Docker configuration.
    CreateApplicationVersion -> Maybe Bool
process :: Prelude.Maybe Prelude.Bool,
    -- | Specify a commit in an AWS CodeCommit Git repository to use as the
    -- source code for the application version.
    CreateApplicationVersion -> Maybe SourceBuildInformation
sourceBuildInformation :: Prelude.Maybe SourceBuildInformation,
    -- | The Amazon S3 bucket and key that identify the location of the source
    -- bundle for this version.
    --
    -- The Amazon S3 bucket must be in the same region as the environment.
    --
    -- Specify a source bundle in S3 or a commit in an AWS CodeCommit
    -- repository (with @SourceBuildInformation@), but not both. If neither
    -- @SourceBundle@ nor @SourceBuildInformation@ are provided, Elastic
    -- Beanstalk uses a sample application.
    CreateApplicationVersion -> Maybe S3Location
sourceBundle :: Prelude.Maybe S3Location,
    -- | Specifies the tags applied to the application version.
    --
    -- Elastic Beanstalk applies these tags only to the application version.
    -- Environments that use the application version don\'t inherit the tags.
    CreateApplicationVersion -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the application. If no application is found with this name,
    -- and @AutoCreateApplication@ is @false@, returns an
    -- @InvalidParameterValue@ error.
    CreateApplicationVersion -> Text
applicationName :: Prelude.Text,
    -- | A label identifying this version.
    --
    -- Constraint: Must be unique per application. If an application version
    -- already exists with this label for the specified application, AWS
    -- Elastic Beanstalk returns an @InvalidParameterValue@ error.
    CreateApplicationVersion -> Text
versionLabel :: Prelude.Text
  }
  deriving (CreateApplicationVersion -> CreateApplicationVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApplicationVersion -> CreateApplicationVersion -> Bool
$c/= :: CreateApplicationVersion -> CreateApplicationVersion -> Bool
== :: CreateApplicationVersion -> CreateApplicationVersion -> Bool
$c== :: CreateApplicationVersion -> CreateApplicationVersion -> Bool
Prelude.Eq, ReadPrec [CreateApplicationVersion]
ReadPrec CreateApplicationVersion
Int -> ReadS CreateApplicationVersion
ReadS [CreateApplicationVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApplicationVersion]
$creadListPrec :: ReadPrec [CreateApplicationVersion]
readPrec :: ReadPrec CreateApplicationVersion
$creadPrec :: ReadPrec CreateApplicationVersion
readList :: ReadS [CreateApplicationVersion]
$creadList :: ReadS [CreateApplicationVersion]
readsPrec :: Int -> ReadS CreateApplicationVersion
$creadsPrec :: Int -> ReadS CreateApplicationVersion
Prelude.Read, Int -> CreateApplicationVersion -> ShowS
[CreateApplicationVersion] -> ShowS
CreateApplicationVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApplicationVersion] -> ShowS
$cshowList :: [CreateApplicationVersion] -> ShowS
show :: CreateApplicationVersion -> String
$cshow :: CreateApplicationVersion -> String
showsPrec :: Int -> CreateApplicationVersion -> ShowS
$cshowsPrec :: Int -> CreateApplicationVersion -> ShowS
Prelude.Show, forall x.
Rep CreateApplicationVersion x -> CreateApplicationVersion
forall x.
CreateApplicationVersion -> Rep CreateApplicationVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateApplicationVersion x -> CreateApplicationVersion
$cfrom :: forall x.
CreateApplicationVersion -> Rep CreateApplicationVersion x
Prelude.Generic)

-- |
-- Create a value of 'CreateApplicationVersion' 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:
--
-- 'autoCreateApplication', 'createApplicationVersion_autoCreateApplication' - Set to @true@ to create an application with the specified name if it
-- doesn\'t already exist.
--
-- 'buildConfiguration', 'createApplicationVersion_buildConfiguration' - Settings for an AWS CodeBuild build.
--
-- 'description', 'createApplicationVersion_description' - A description of this application version.
--
-- 'process', 'createApplicationVersion_process' - Pre-processes and validates the environment manifest (@env.yaml@) and
-- configuration files (@*.config@ files in the @.ebextensions@ folder) in
-- the source bundle. Validating configuration files can identify issues
-- prior to deploying the application version to an environment.
--
-- You must turn processing on for application versions that you create
-- using AWS CodeBuild or AWS CodeCommit. For application versions built
-- from a source bundle in Amazon S3, processing is optional.
--
-- The @Process@ option validates Elastic Beanstalk configuration files. It
-- doesn\'t validate your application\'s configuration files, like proxy
-- server or Docker configuration.
--
-- 'sourceBuildInformation', 'createApplicationVersion_sourceBuildInformation' - Specify a commit in an AWS CodeCommit Git repository to use as the
-- source code for the application version.
--
-- 'sourceBundle', 'createApplicationVersion_sourceBundle' - The Amazon S3 bucket and key that identify the location of the source
-- bundle for this version.
--
-- The Amazon S3 bucket must be in the same region as the environment.
--
-- Specify a source bundle in S3 or a commit in an AWS CodeCommit
-- repository (with @SourceBuildInformation@), but not both. If neither
-- @SourceBundle@ nor @SourceBuildInformation@ are provided, Elastic
-- Beanstalk uses a sample application.
--
-- 'tags', 'createApplicationVersion_tags' - Specifies the tags applied to the application version.
--
-- Elastic Beanstalk applies these tags only to the application version.
-- Environments that use the application version don\'t inherit the tags.
--
-- 'applicationName', 'createApplicationVersion_applicationName' - The name of the application. If no application is found with this name,
-- and @AutoCreateApplication@ is @false@, returns an
-- @InvalidParameterValue@ error.
--
-- 'versionLabel', 'createApplicationVersion_versionLabel' - A label identifying this version.
--
-- Constraint: Must be unique per application. If an application version
-- already exists with this label for the specified application, AWS
-- Elastic Beanstalk returns an @InvalidParameterValue@ error.
newCreateApplicationVersion ::
  -- | 'applicationName'
  Prelude.Text ->
  -- | 'versionLabel'
  Prelude.Text ->
  CreateApplicationVersion
newCreateApplicationVersion :: Text -> Text -> CreateApplicationVersion
newCreateApplicationVersion
  Text
pApplicationName_
  Text
pVersionLabel_ =
    CreateApplicationVersion'
      { $sel:autoCreateApplication:CreateApplicationVersion' :: Maybe Bool
autoCreateApplication =
          forall a. Maybe a
Prelude.Nothing,
        $sel:buildConfiguration:CreateApplicationVersion' :: Maybe BuildConfiguration
buildConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateApplicationVersion' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:process:CreateApplicationVersion' :: Maybe Bool
process = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceBuildInformation:CreateApplicationVersion' :: Maybe SourceBuildInformation
sourceBuildInformation = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceBundle:CreateApplicationVersion' :: Maybe S3Location
sourceBundle = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateApplicationVersion' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:applicationName:CreateApplicationVersion' :: Text
applicationName = Text
pApplicationName_,
        $sel:versionLabel:CreateApplicationVersion' :: Text
versionLabel = Text
pVersionLabel_
      }

-- | Set to @true@ to create an application with the specified name if it
-- doesn\'t already exist.
createApplicationVersion_autoCreateApplication :: Lens.Lens' CreateApplicationVersion (Prelude.Maybe Prelude.Bool)
createApplicationVersion_autoCreateApplication :: Lens' CreateApplicationVersion (Maybe Bool)
createApplicationVersion_autoCreateApplication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Maybe Bool
autoCreateApplication :: Maybe Bool
$sel:autoCreateApplication:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Bool
autoCreateApplication} -> Maybe Bool
autoCreateApplication) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Maybe Bool
a -> CreateApplicationVersion
s {$sel:autoCreateApplication:CreateApplicationVersion' :: Maybe Bool
autoCreateApplication = Maybe Bool
a} :: CreateApplicationVersion)

-- | Settings for an AWS CodeBuild build.
createApplicationVersion_buildConfiguration :: Lens.Lens' CreateApplicationVersion (Prelude.Maybe BuildConfiguration)
createApplicationVersion_buildConfiguration :: Lens' CreateApplicationVersion (Maybe BuildConfiguration)
createApplicationVersion_buildConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Maybe BuildConfiguration
buildConfiguration :: Maybe BuildConfiguration
$sel:buildConfiguration:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe BuildConfiguration
buildConfiguration} -> Maybe BuildConfiguration
buildConfiguration) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Maybe BuildConfiguration
a -> CreateApplicationVersion
s {$sel:buildConfiguration:CreateApplicationVersion' :: Maybe BuildConfiguration
buildConfiguration = Maybe BuildConfiguration
a} :: CreateApplicationVersion)

-- | A description of this application version.
createApplicationVersion_description :: Lens.Lens' CreateApplicationVersion (Prelude.Maybe Prelude.Text)
createApplicationVersion_description :: Lens' CreateApplicationVersion (Maybe Text)
createApplicationVersion_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Maybe Text
description :: Maybe Text
$sel:description:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Maybe Text
a -> CreateApplicationVersion
s {$sel:description:CreateApplicationVersion' :: Maybe Text
description = Maybe Text
a} :: CreateApplicationVersion)

-- | Pre-processes and validates the environment manifest (@env.yaml@) and
-- configuration files (@*.config@ files in the @.ebextensions@ folder) in
-- the source bundle. Validating configuration files can identify issues
-- prior to deploying the application version to an environment.
--
-- You must turn processing on for application versions that you create
-- using AWS CodeBuild or AWS CodeCommit. For application versions built
-- from a source bundle in Amazon S3, processing is optional.
--
-- The @Process@ option validates Elastic Beanstalk configuration files. It
-- doesn\'t validate your application\'s configuration files, like proxy
-- server or Docker configuration.
createApplicationVersion_process :: Lens.Lens' CreateApplicationVersion (Prelude.Maybe Prelude.Bool)
createApplicationVersion_process :: Lens' CreateApplicationVersion (Maybe Bool)
createApplicationVersion_process = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Maybe Bool
process :: Maybe Bool
$sel:process:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Bool
process} -> Maybe Bool
process) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Maybe Bool
a -> CreateApplicationVersion
s {$sel:process:CreateApplicationVersion' :: Maybe Bool
process = Maybe Bool
a} :: CreateApplicationVersion)

-- | Specify a commit in an AWS CodeCommit Git repository to use as the
-- source code for the application version.
createApplicationVersion_sourceBuildInformation :: Lens.Lens' CreateApplicationVersion (Prelude.Maybe SourceBuildInformation)
createApplicationVersion_sourceBuildInformation :: Lens' CreateApplicationVersion (Maybe SourceBuildInformation)
createApplicationVersion_sourceBuildInformation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Maybe SourceBuildInformation
sourceBuildInformation :: Maybe SourceBuildInformation
$sel:sourceBuildInformation:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe SourceBuildInformation
sourceBuildInformation} -> Maybe SourceBuildInformation
sourceBuildInformation) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Maybe SourceBuildInformation
a -> CreateApplicationVersion
s {$sel:sourceBuildInformation:CreateApplicationVersion' :: Maybe SourceBuildInformation
sourceBuildInformation = Maybe SourceBuildInformation
a} :: CreateApplicationVersion)

-- | The Amazon S3 bucket and key that identify the location of the source
-- bundle for this version.
--
-- The Amazon S3 bucket must be in the same region as the environment.
--
-- Specify a source bundle in S3 or a commit in an AWS CodeCommit
-- repository (with @SourceBuildInformation@), but not both. If neither
-- @SourceBundle@ nor @SourceBuildInformation@ are provided, Elastic
-- Beanstalk uses a sample application.
createApplicationVersion_sourceBundle :: Lens.Lens' CreateApplicationVersion (Prelude.Maybe S3Location)
createApplicationVersion_sourceBundle :: Lens' CreateApplicationVersion (Maybe S3Location)
createApplicationVersion_sourceBundle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Maybe S3Location
sourceBundle :: Maybe S3Location
$sel:sourceBundle:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe S3Location
sourceBundle} -> Maybe S3Location
sourceBundle) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Maybe S3Location
a -> CreateApplicationVersion
s {$sel:sourceBundle:CreateApplicationVersion' :: Maybe S3Location
sourceBundle = Maybe S3Location
a} :: CreateApplicationVersion)

-- | Specifies the tags applied to the application version.
--
-- Elastic Beanstalk applies these tags only to the application version.
-- Environments that use the application version don\'t inherit the tags.
createApplicationVersion_tags :: Lens.Lens' CreateApplicationVersion (Prelude.Maybe [Tag])
createApplicationVersion_tags :: Lens' CreateApplicationVersion (Maybe [Tag])
createApplicationVersion_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Maybe [Tag]
a -> CreateApplicationVersion
s {$sel:tags:CreateApplicationVersion' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateApplicationVersion) 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. If no application is found with this name,
-- and @AutoCreateApplication@ is @false@, returns an
-- @InvalidParameterValue@ error.
createApplicationVersion_applicationName :: Lens.Lens' CreateApplicationVersion Prelude.Text
createApplicationVersion_applicationName :: Lens' CreateApplicationVersion Text
createApplicationVersion_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Text
applicationName :: Text
$sel:applicationName:CreateApplicationVersion' :: CreateApplicationVersion -> Text
applicationName} -> Text
applicationName) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Text
a -> CreateApplicationVersion
s {$sel:applicationName:CreateApplicationVersion' :: Text
applicationName = Text
a} :: CreateApplicationVersion)

-- | A label identifying this version.
--
-- Constraint: Must be unique per application. If an application version
-- already exists with this label for the specified application, AWS
-- Elastic Beanstalk returns an @InvalidParameterValue@ error.
createApplicationVersion_versionLabel :: Lens.Lens' CreateApplicationVersion Prelude.Text
createApplicationVersion_versionLabel :: Lens' CreateApplicationVersion Text
createApplicationVersion_versionLabel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Text
versionLabel :: Text
$sel:versionLabel:CreateApplicationVersion' :: CreateApplicationVersion -> Text
versionLabel} -> Text
versionLabel) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Text
a -> CreateApplicationVersion
s {$sel:versionLabel:CreateApplicationVersion' :: Text
versionLabel = Text
a} :: CreateApplicationVersion)

instance Core.AWSRequest CreateApplicationVersion where
  type
    AWSResponse CreateApplicationVersion =
      ApplicationVersionDescriptionMessage
  request :: (Service -> Service)
-> CreateApplicationVersion -> Request CreateApplicationVersion
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 CreateApplicationVersion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateApplicationVersion)))
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
"CreateApplicationVersionResult"
      (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance Prelude.Hashable CreateApplicationVersion where
  hashWithSalt :: Int -> CreateApplicationVersion -> Int
hashWithSalt Int
_salt CreateApplicationVersion' {Maybe Bool
Maybe [Tag]
Maybe Text
Maybe BuildConfiguration
Maybe S3Location
Maybe SourceBuildInformation
Text
versionLabel :: Text
applicationName :: Text
tags :: Maybe [Tag]
sourceBundle :: Maybe S3Location
sourceBuildInformation :: Maybe SourceBuildInformation
process :: Maybe Bool
description :: Maybe Text
buildConfiguration :: Maybe BuildConfiguration
autoCreateApplication :: Maybe Bool
$sel:versionLabel:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:applicationName:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:tags:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe [Tag]
$sel:sourceBundle:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe S3Location
$sel:sourceBuildInformation:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe SourceBuildInformation
$sel:process:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Bool
$sel:description:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:buildConfiguration:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe BuildConfiguration
$sel:autoCreateApplication:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoCreateApplication
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BuildConfiguration
buildConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
process
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SourceBuildInformation
sourceBuildInformation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe S3Location
sourceBundle
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
versionLabel

instance Prelude.NFData CreateApplicationVersion where
  rnf :: CreateApplicationVersion -> ()
rnf CreateApplicationVersion' {Maybe Bool
Maybe [Tag]
Maybe Text
Maybe BuildConfiguration
Maybe S3Location
Maybe SourceBuildInformation
Text
versionLabel :: Text
applicationName :: Text
tags :: Maybe [Tag]
sourceBundle :: Maybe S3Location
sourceBuildInformation :: Maybe SourceBuildInformation
process :: Maybe Bool
description :: Maybe Text
buildConfiguration :: Maybe BuildConfiguration
autoCreateApplication :: Maybe Bool
$sel:versionLabel:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:applicationName:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:tags:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe [Tag]
$sel:sourceBundle:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe S3Location
$sel:sourceBuildInformation:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe SourceBuildInformation
$sel:process:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Bool
$sel:description:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:buildConfiguration:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe BuildConfiguration
$sel:autoCreateApplication:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoCreateApplication
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BuildConfiguration
buildConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Bool
process
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SourceBuildInformation
sourceBuildInformation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe S3Location
sourceBundle
      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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
versionLabel

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

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

instance Data.ToQuery CreateApplicationVersion where
  toQuery :: CreateApplicationVersion -> QueryString
toQuery CreateApplicationVersion' {Maybe Bool
Maybe [Tag]
Maybe Text
Maybe BuildConfiguration
Maybe S3Location
Maybe SourceBuildInformation
Text
versionLabel :: Text
applicationName :: Text
tags :: Maybe [Tag]
sourceBundle :: Maybe S3Location
sourceBuildInformation :: Maybe SourceBuildInformation
process :: Maybe Bool
description :: Maybe Text
buildConfiguration :: Maybe BuildConfiguration
autoCreateApplication :: Maybe Bool
$sel:versionLabel:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:applicationName:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:tags:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe [Tag]
$sel:sourceBundle:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe S3Location
$sel:sourceBuildInformation:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe SourceBuildInformation
$sel:process:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Bool
$sel:description:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:buildConfiguration:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe BuildConfiguration
$sel:autoCreateApplication:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateApplicationVersion" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"AutoCreateApplication"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
autoCreateApplication,
        ByteString
"BuildConfiguration" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe BuildConfiguration
buildConfiguration,
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"Process" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
process,
        ByteString
"SourceBuildInformation"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SourceBuildInformation
sourceBuildInformation,
        ByteString
"SourceBundle" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe S3Location
sourceBundle,
        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,
        ByteString
"VersionLabel" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
versionLabel
      ]