{-# 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.ServerlessApplicationRepository.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.
module Amazonka.ServerlessApplicationRepository.CreateApplicationVersion
  ( -- * Creating a Request
    CreateApplicationVersion (..),
    newCreateApplicationVersion,

    -- * Request Lenses
    createApplicationVersion_sourceCodeArchiveUrl,
    createApplicationVersion_sourceCodeUrl,
    createApplicationVersion_templateBody,
    createApplicationVersion_templateUrl,
    createApplicationVersion_applicationId,
    createApplicationVersion_semanticVersion,

    -- * Destructuring the Response
    CreateApplicationVersionResponse (..),
    newCreateApplicationVersionResponse,

    -- * Response Lenses
    createApplicationVersionResponse_applicationId,
    createApplicationVersionResponse_creationTime,
    createApplicationVersionResponse_parameterDefinitions,
    createApplicationVersionResponse_requiredCapabilities,
    createApplicationVersionResponse_resourcesSupported,
    createApplicationVersionResponse_semanticVersion,
    createApplicationVersionResponse_sourceCodeArchiveUrl,
    createApplicationVersionResponse_sourceCodeUrl,
    createApplicationVersionResponse_templateUrl,
    createApplicationVersionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateApplicationVersion' smart constructor.
data CreateApplicationVersion = CreateApplicationVersion'
  { -- | A link to the S3 object that contains the ZIP archive of the source code
    -- for this version of your application.
    --
    -- Maximum size 50 MB
    CreateApplicationVersion -> Maybe Text
sourceCodeArchiveUrl :: Prelude.Maybe Prelude.Text,
    -- | A link to a public repository for the source code of your application,
    -- for example the URL of a specific GitHub commit.
    CreateApplicationVersion -> Maybe Text
sourceCodeUrl :: Prelude.Maybe Prelude.Text,
    -- | The raw packaged AWS SAM template of your application.
    CreateApplicationVersion -> Maybe Text
templateBody :: Prelude.Maybe Prelude.Text,
    -- | A link to the packaged AWS SAM template of your application.
    CreateApplicationVersion -> Maybe Text
templateUrl :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the application.
    CreateApplicationVersion -> Text
applicationId :: Prelude.Text,
    -- | The semantic version of the new version.
    CreateApplicationVersion -> Text
semanticVersion :: 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:
--
-- 'sourceCodeArchiveUrl', 'createApplicationVersion_sourceCodeArchiveUrl' - A link to the S3 object that contains the ZIP archive of the source code
-- for this version of your application.
--
-- Maximum size 50 MB
--
-- 'sourceCodeUrl', 'createApplicationVersion_sourceCodeUrl' - A link to a public repository for the source code of your application,
-- for example the URL of a specific GitHub commit.
--
-- 'templateBody', 'createApplicationVersion_templateBody' - The raw packaged AWS SAM template of your application.
--
-- 'templateUrl', 'createApplicationVersion_templateUrl' - A link to the packaged AWS SAM template of your application.
--
-- 'applicationId', 'createApplicationVersion_applicationId' - The Amazon Resource Name (ARN) of the application.
--
-- 'semanticVersion', 'createApplicationVersion_semanticVersion' - The semantic version of the new version.
newCreateApplicationVersion ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'semanticVersion'
  Prelude.Text ->
  CreateApplicationVersion
newCreateApplicationVersion :: Text -> Text -> CreateApplicationVersion
newCreateApplicationVersion
  Text
pApplicationId_
  Text
pSemanticVersion_ =
    CreateApplicationVersion'
      { $sel:sourceCodeArchiveUrl:CreateApplicationVersion' :: Maybe Text
sourceCodeArchiveUrl =
          forall a. Maybe a
Prelude.Nothing,
        $sel:sourceCodeUrl:CreateApplicationVersion' :: Maybe Text
sourceCodeUrl = forall a. Maybe a
Prelude.Nothing,
        $sel:templateBody:CreateApplicationVersion' :: Maybe Text
templateBody = forall a. Maybe a
Prelude.Nothing,
        $sel:templateUrl:CreateApplicationVersion' :: Maybe Text
templateUrl = forall a. Maybe a
Prelude.Nothing,
        $sel:applicationId:CreateApplicationVersion' :: Text
applicationId = Text
pApplicationId_,
        $sel:semanticVersion:CreateApplicationVersion' :: Text
semanticVersion = Text
pSemanticVersion_
      }

-- | A link to the S3 object that contains the ZIP archive of the source code
-- for this version of your application.
--
-- Maximum size 50 MB
createApplicationVersion_sourceCodeArchiveUrl :: Lens.Lens' CreateApplicationVersion (Prelude.Maybe Prelude.Text)
createApplicationVersion_sourceCodeArchiveUrl :: Lens' CreateApplicationVersion (Maybe Text)
createApplicationVersion_sourceCodeArchiveUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Maybe Text
sourceCodeArchiveUrl :: Maybe Text
$sel:sourceCodeArchiveUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
sourceCodeArchiveUrl} -> Maybe Text
sourceCodeArchiveUrl) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Maybe Text
a -> CreateApplicationVersion
s {$sel:sourceCodeArchiveUrl:CreateApplicationVersion' :: Maybe Text
sourceCodeArchiveUrl = Maybe Text
a} :: CreateApplicationVersion)

-- | A link to a public repository for the source code of your application,
-- for example the URL of a specific GitHub commit.
createApplicationVersion_sourceCodeUrl :: Lens.Lens' CreateApplicationVersion (Prelude.Maybe Prelude.Text)
createApplicationVersion_sourceCodeUrl :: Lens' CreateApplicationVersion (Maybe Text)
createApplicationVersion_sourceCodeUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Maybe Text
sourceCodeUrl :: Maybe Text
$sel:sourceCodeUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
sourceCodeUrl} -> Maybe Text
sourceCodeUrl) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Maybe Text
a -> CreateApplicationVersion
s {$sel:sourceCodeUrl:CreateApplicationVersion' :: Maybe Text
sourceCodeUrl = Maybe Text
a} :: CreateApplicationVersion)

-- | The raw packaged AWS SAM template of your application.
createApplicationVersion_templateBody :: Lens.Lens' CreateApplicationVersion (Prelude.Maybe Prelude.Text)
createApplicationVersion_templateBody :: Lens' CreateApplicationVersion (Maybe Text)
createApplicationVersion_templateBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Maybe Text
templateBody :: Maybe Text
$sel:templateBody:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
templateBody} -> Maybe Text
templateBody) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Maybe Text
a -> CreateApplicationVersion
s {$sel:templateBody:CreateApplicationVersion' :: Maybe Text
templateBody = Maybe Text
a} :: CreateApplicationVersion)

-- | A link to the packaged AWS SAM template of your application.
createApplicationVersion_templateUrl :: Lens.Lens' CreateApplicationVersion (Prelude.Maybe Prelude.Text)
createApplicationVersion_templateUrl :: Lens' CreateApplicationVersion (Maybe Text)
createApplicationVersion_templateUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Maybe Text
templateUrl :: Maybe Text
$sel:templateUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
templateUrl} -> Maybe Text
templateUrl) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Maybe Text
a -> CreateApplicationVersion
s {$sel:templateUrl:CreateApplicationVersion' :: Maybe Text
templateUrl = Maybe Text
a} :: CreateApplicationVersion)

-- | The Amazon Resource Name (ARN) of the application.
createApplicationVersion_applicationId :: Lens.Lens' CreateApplicationVersion Prelude.Text
createApplicationVersion_applicationId :: Lens' CreateApplicationVersion Text
createApplicationVersion_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Text
applicationId :: Text
$sel:applicationId:CreateApplicationVersion' :: CreateApplicationVersion -> Text
applicationId} -> Text
applicationId) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Text
a -> CreateApplicationVersion
s {$sel:applicationId:CreateApplicationVersion' :: Text
applicationId = Text
a} :: CreateApplicationVersion)

-- | The semantic version of the new version.
createApplicationVersion_semanticVersion :: Lens.Lens' CreateApplicationVersion Prelude.Text
createApplicationVersion_semanticVersion :: Lens' CreateApplicationVersion Text
createApplicationVersion_semanticVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersion' {Text
semanticVersion :: Text
$sel:semanticVersion:CreateApplicationVersion' :: CreateApplicationVersion -> Text
semanticVersion} -> Text
semanticVersion) (\s :: CreateApplicationVersion
s@CreateApplicationVersion' {} Text
a -> CreateApplicationVersion
s {$sel:semanticVersion:CreateApplicationVersion' :: Text
semanticVersion = Text
a} :: CreateApplicationVersion)

instance Core.AWSRequest CreateApplicationVersion where
  type
    AWSResponse CreateApplicationVersion =
      CreateApplicationVersionResponse
  request :: (Service -> Service)
-> CreateApplicationVersion -> Request CreateApplicationVersion
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (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 =>
(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
-> Maybe Text
-> Maybe [ParameterDefinition]
-> Maybe [Capability]
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> CreateApplicationVersionResponse
CreateApplicationVersionResponse'
            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
"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 (Maybe a)
Data..?> Key
"creationTime")
            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
"parameterDefinitions"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"requiredCapabilities"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"resourcesSupported")
            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
"semanticVersion")
            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
"sourceCodeArchiveUrl")
            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
"sourceCodeUrl")
            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
"templateUrl")
            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 CreateApplicationVersion where
  hashWithSalt :: Int -> CreateApplicationVersion -> Int
hashWithSalt Int
_salt CreateApplicationVersion' {Maybe Text
Text
semanticVersion :: Text
applicationId :: Text
templateUrl :: Maybe Text
templateBody :: Maybe Text
sourceCodeUrl :: Maybe Text
sourceCodeArchiveUrl :: Maybe Text
$sel:semanticVersion:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:applicationId:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:templateUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:templateBody:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:sourceCodeUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:sourceCodeArchiveUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceCodeArchiveUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceCodeUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateBody
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
semanticVersion

instance Prelude.NFData CreateApplicationVersion where
  rnf :: CreateApplicationVersion -> ()
rnf CreateApplicationVersion' {Maybe Text
Text
semanticVersion :: Text
applicationId :: Text
templateUrl :: Maybe Text
templateBody :: Maybe Text
sourceCodeUrl :: Maybe Text
sourceCodeArchiveUrl :: Maybe Text
$sel:semanticVersion:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:applicationId:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:templateUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:templateBody:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:sourceCodeUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:sourceCodeArchiveUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceCodeArchiveUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceCodeUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateBody
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateUrl
      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
semanticVersion

instance Data.ToHeaders CreateApplicationVersion where
  toHeaders :: CreateApplicationVersion -> 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 CreateApplicationVersion where
  toJSON :: CreateApplicationVersion -> Value
toJSON CreateApplicationVersion' {Maybe Text
Text
semanticVersion :: Text
applicationId :: Text
templateUrl :: Maybe Text
templateBody :: Maybe Text
sourceCodeUrl :: Maybe Text
sourceCodeArchiveUrl :: Maybe Text
$sel:semanticVersion:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:applicationId:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:templateUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:templateBody:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:sourceCodeUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:sourceCodeArchiveUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"sourceCodeArchiveUrl" 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
sourceCodeArchiveUrl,
            (Key
"sourceCodeUrl" 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
sourceCodeUrl,
            (Key
"templateBody" 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
templateBody,
            (Key
"templateUrl" 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
templateUrl
          ]
      )

instance Data.ToPath CreateApplicationVersion where
  toPath :: CreateApplicationVersion -> ByteString
toPath CreateApplicationVersion' {Maybe Text
Text
semanticVersion :: Text
applicationId :: Text
templateUrl :: Maybe Text
templateBody :: Maybe Text
sourceCodeUrl :: Maybe Text
sourceCodeArchiveUrl :: Maybe Text
$sel:semanticVersion:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:applicationId:CreateApplicationVersion' :: CreateApplicationVersion -> Text
$sel:templateUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:templateBody:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:sourceCodeUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
$sel:sourceCodeArchiveUrl:CreateApplicationVersion' :: CreateApplicationVersion -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/applications/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/versions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
semanticVersion
      ]

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

-- | /See:/ 'newCreateApplicationVersionResponse' smart constructor.
data CreateApplicationVersionResponse = CreateApplicationVersionResponse'
  { -- | The application Amazon Resource Name (ARN).
    CreateApplicationVersionResponse -> Maybe Text
applicationId :: Prelude.Maybe Prelude.Text,
    -- | The date and time this resource was created.
    CreateApplicationVersionResponse -> Maybe Text
creationTime :: Prelude.Maybe Prelude.Text,
    -- | An array of parameter types supported by the application.
    CreateApplicationVersionResponse -> Maybe [ParameterDefinition]
parameterDefinitions :: Prelude.Maybe [ParameterDefinition],
    -- | A list of values that you must specify before you can deploy certain
    -- applications. Some applications might include resources that can affect
    -- permissions in your AWS account, for example, by creating new AWS
    -- Identity and Access Management (IAM) users. For those applications, you
    -- must explicitly acknowledge their capabilities by specifying this
    -- parameter.
    --
    -- The only valid values are CAPABILITY_IAM, CAPABILITY_NAMED_IAM,
    -- CAPABILITY_RESOURCE_POLICY, and CAPABILITY_AUTO_EXPAND.
    --
    -- The following resources require you to specify CAPABILITY_IAM or
    -- CAPABILITY_NAMED_IAM:
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iam-group.html AWS::IAM::Group>,
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-instanceprofile.html AWS::IAM::InstanceProfile>,
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-policy.html AWS::IAM::Policy>,
    -- and
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-role.html AWS::IAM::Role>.
    -- If the application contains IAM resources, you can specify either
    -- CAPABILITY_IAM or CAPABILITY_NAMED_IAM. If the application contains IAM
    -- resources with custom names, you must specify CAPABILITY_NAMED_IAM.
    --
    -- The following resources require you to specify
    -- CAPABILITY_RESOURCE_POLICY:
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lambda-permission.html AWS::Lambda::Permission>,
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-policy.html AWS::IAM:Policy>,
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-applicationautoscaling-scalingpolicy.html AWS::ApplicationAutoScaling::ScalingPolicy>,
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-s3-policy.html AWS::S3::BucketPolicy>,
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sqs-policy.html AWS::SQS::QueuePolicy>,
    -- and
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sns-policy.html AWS::SNS::TopicPolicy>.
    --
    -- Applications that contain one or more nested applications require you to
    -- specify CAPABILITY_AUTO_EXPAND.
    --
    -- If your application template contains any of the above resources, we
    -- recommend that you review all permissions associated with the
    -- application before deploying. If you don\'t specify this parameter for
    -- an application that requires capabilities, the call will fail.
    CreateApplicationVersionResponse -> Maybe [Capability]
requiredCapabilities :: Prelude.Maybe [Capability],
    -- | Whether all of the AWS resources contained in this application are
    -- supported in the region in which it is being retrieved.
    CreateApplicationVersionResponse -> Maybe Bool
resourcesSupported :: Prelude.Maybe Prelude.Bool,
    -- | The semantic version of the application:
    --
    -- <https://semver.org/>
    CreateApplicationVersionResponse -> Maybe Text
semanticVersion :: Prelude.Maybe Prelude.Text,
    -- | A link to the S3 object that contains the ZIP archive of the source code
    -- for this version of your application.
    --
    -- Maximum size 50 MB
    CreateApplicationVersionResponse -> Maybe Text
sourceCodeArchiveUrl :: Prelude.Maybe Prelude.Text,
    -- | A link to a public repository for the source code of your application,
    -- for example the URL of a specific GitHub commit.
    CreateApplicationVersionResponse -> Maybe Text
sourceCodeUrl :: Prelude.Maybe Prelude.Text,
    -- | A link to the packaged AWS SAM template of your application.
    CreateApplicationVersionResponse -> Maybe Text
templateUrl :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateApplicationVersionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateApplicationVersionResponse
-> CreateApplicationVersionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApplicationVersionResponse
-> CreateApplicationVersionResponse -> Bool
$c/= :: CreateApplicationVersionResponse
-> CreateApplicationVersionResponse -> Bool
== :: CreateApplicationVersionResponse
-> CreateApplicationVersionResponse -> Bool
$c== :: CreateApplicationVersionResponse
-> CreateApplicationVersionResponse -> Bool
Prelude.Eq, ReadPrec [CreateApplicationVersionResponse]
ReadPrec CreateApplicationVersionResponse
Int -> ReadS CreateApplicationVersionResponse
ReadS [CreateApplicationVersionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApplicationVersionResponse]
$creadListPrec :: ReadPrec [CreateApplicationVersionResponse]
readPrec :: ReadPrec CreateApplicationVersionResponse
$creadPrec :: ReadPrec CreateApplicationVersionResponse
readList :: ReadS [CreateApplicationVersionResponse]
$creadList :: ReadS [CreateApplicationVersionResponse]
readsPrec :: Int -> ReadS CreateApplicationVersionResponse
$creadsPrec :: Int -> ReadS CreateApplicationVersionResponse
Prelude.Read, Int -> CreateApplicationVersionResponse -> ShowS
[CreateApplicationVersionResponse] -> ShowS
CreateApplicationVersionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApplicationVersionResponse] -> ShowS
$cshowList :: [CreateApplicationVersionResponse] -> ShowS
show :: CreateApplicationVersionResponse -> String
$cshow :: CreateApplicationVersionResponse -> String
showsPrec :: Int -> CreateApplicationVersionResponse -> ShowS
$cshowsPrec :: Int -> CreateApplicationVersionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateApplicationVersionResponse x
-> CreateApplicationVersionResponse
forall x.
CreateApplicationVersionResponse
-> Rep CreateApplicationVersionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateApplicationVersionResponse x
-> CreateApplicationVersionResponse
$cfrom :: forall x.
CreateApplicationVersionResponse
-> Rep CreateApplicationVersionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateApplicationVersionResponse' 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:
--
-- 'applicationId', 'createApplicationVersionResponse_applicationId' - The application Amazon Resource Name (ARN).
--
-- 'creationTime', 'createApplicationVersionResponse_creationTime' - The date and time this resource was created.
--
-- 'parameterDefinitions', 'createApplicationVersionResponse_parameterDefinitions' - An array of parameter types supported by the application.
--
-- 'requiredCapabilities', 'createApplicationVersionResponse_requiredCapabilities' - A list of values that you must specify before you can deploy certain
-- applications. Some applications might include resources that can affect
-- permissions in your AWS account, for example, by creating new AWS
-- Identity and Access Management (IAM) users. For those applications, you
-- must explicitly acknowledge their capabilities by specifying this
-- parameter.
--
-- The only valid values are CAPABILITY_IAM, CAPABILITY_NAMED_IAM,
-- CAPABILITY_RESOURCE_POLICY, and CAPABILITY_AUTO_EXPAND.
--
-- The following resources require you to specify CAPABILITY_IAM or
-- CAPABILITY_NAMED_IAM:
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iam-group.html AWS::IAM::Group>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-instanceprofile.html AWS::IAM::InstanceProfile>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-policy.html AWS::IAM::Policy>,
-- and
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-role.html AWS::IAM::Role>.
-- If the application contains IAM resources, you can specify either
-- CAPABILITY_IAM or CAPABILITY_NAMED_IAM. If the application contains IAM
-- resources with custom names, you must specify CAPABILITY_NAMED_IAM.
--
-- The following resources require you to specify
-- CAPABILITY_RESOURCE_POLICY:
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lambda-permission.html AWS::Lambda::Permission>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-policy.html AWS::IAM:Policy>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-applicationautoscaling-scalingpolicy.html AWS::ApplicationAutoScaling::ScalingPolicy>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-s3-policy.html AWS::S3::BucketPolicy>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sqs-policy.html AWS::SQS::QueuePolicy>,
-- and
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sns-policy.html AWS::SNS::TopicPolicy>.
--
-- Applications that contain one or more nested applications require you to
-- specify CAPABILITY_AUTO_EXPAND.
--
-- If your application template contains any of the above resources, we
-- recommend that you review all permissions associated with the
-- application before deploying. If you don\'t specify this parameter for
-- an application that requires capabilities, the call will fail.
--
-- 'resourcesSupported', 'createApplicationVersionResponse_resourcesSupported' - Whether all of the AWS resources contained in this application are
-- supported in the region in which it is being retrieved.
--
-- 'semanticVersion', 'createApplicationVersionResponse_semanticVersion' - The semantic version of the application:
--
-- <https://semver.org/>
--
-- 'sourceCodeArchiveUrl', 'createApplicationVersionResponse_sourceCodeArchiveUrl' - A link to the S3 object that contains the ZIP archive of the source code
-- for this version of your application.
--
-- Maximum size 50 MB
--
-- 'sourceCodeUrl', 'createApplicationVersionResponse_sourceCodeUrl' - A link to a public repository for the source code of your application,
-- for example the URL of a specific GitHub commit.
--
-- 'templateUrl', 'createApplicationVersionResponse_templateUrl' - A link to the packaged AWS SAM template of your application.
--
-- 'httpStatus', 'createApplicationVersionResponse_httpStatus' - The response's http status code.
newCreateApplicationVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateApplicationVersionResponse
newCreateApplicationVersionResponse :: Int -> CreateApplicationVersionResponse
newCreateApplicationVersionResponse Int
pHttpStatus_ =
  CreateApplicationVersionResponse'
    { $sel:applicationId:CreateApplicationVersionResponse' :: Maybe Text
applicationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:CreateApplicationVersionResponse' :: Maybe Text
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:parameterDefinitions:CreateApplicationVersionResponse' :: Maybe [ParameterDefinition]
parameterDefinitions = forall a. Maybe a
Prelude.Nothing,
      $sel:requiredCapabilities:CreateApplicationVersionResponse' :: Maybe [Capability]
requiredCapabilities = forall a. Maybe a
Prelude.Nothing,
      $sel:resourcesSupported:CreateApplicationVersionResponse' :: Maybe Bool
resourcesSupported = forall a. Maybe a
Prelude.Nothing,
      $sel:semanticVersion:CreateApplicationVersionResponse' :: Maybe Text
semanticVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceCodeArchiveUrl:CreateApplicationVersionResponse' :: Maybe Text
sourceCodeArchiveUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceCodeUrl:CreateApplicationVersionResponse' :: Maybe Text
sourceCodeUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:templateUrl:CreateApplicationVersionResponse' :: Maybe Text
templateUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateApplicationVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The application Amazon Resource Name (ARN).
createApplicationVersionResponse_applicationId :: Lens.Lens' CreateApplicationVersionResponse (Prelude.Maybe Prelude.Text)
createApplicationVersionResponse_applicationId :: Lens' CreateApplicationVersionResponse (Maybe Text)
createApplicationVersionResponse_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersionResponse' {Maybe Text
applicationId :: Maybe Text
$sel:applicationId:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Text
applicationId} -> Maybe Text
applicationId) (\s :: CreateApplicationVersionResponse
s@CreateApplicationVersionResponse' {} Maybe Text
a -> CreateApplicationVersionResponse
s {$sel:applicationId:CreateApplicationVersionResponse' :: Maybe Text
applicationId = Maybe Text
a} :: CreateApplicationVersionResponse)

-- | The date and time this resource was created.
createApplicationVersionResponse_creationTime :: Lens.Lens' CreateApplicationVersionResponse (Prelude.Maybe Prelude.Text)
createApplicationVersionResponse_creationTime :: Lens' CreateApplicationVersionResponse (Maybe Text)
createApplicationVersionResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersionResponse' {Maybe Text
creationTime :: Maybe Text
$sel:creationTime:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Text
creationTime} -> Maybe Text
creationTime) (\s :: CreateApplicationVersionResponse
s@CreateApplicationVersionResponse' {} Maybe Text
a -> CreateApplicationVersionResponse
s {$sel:creationTime:CreateApplicationVersionResponse' :: Maybe Text
creationTime = Maybe Text
a} :: CreateApplicationVersionResponse)

-- | An array of parameter types supported by the application.
createApplicationVersionResponse_parameterDefinitions :: Lens.Lens' CreateApplicationVersionResponse (Prelude.Maybe [ParameterDefinition])
createApplicationVersionResponse_parameterDefinitions :: Lens'
  CreateApplicationVersionResponse (Maybe [ParameterDefinition])
createApplicationVersionResponse_parameterDefinitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersionResponse' {Maybe [ParameterDefinition]
parameterDefinitions :: Maybe [ParameterDefinition]
$sel:parameterDefinitions:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe [ParameterDefinition]
parameterDefinitions} -> Maybe [ParameterDefinition]
parameterDefinitions) (\s :: CreateApplicationVersionResponse
s@CreateApplicationVersionResponse' {} Maybe [ParameterDefinition]
a -> CreateApplicationVersionResponse
s {$sel:parameterDefinitions:CreateApplicationVersionResponse' :: Maybe [ParameterDefinition]
parameterDefinitions = Maybe [ParameterDefinition]
a} :: CreateApplicationVersionResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A list of values that you must specify before you can deploy certain
-- applications. Some applications might include resources that can affect
-- permissions in your AWS account, for example, by creating new AWS
-- Identity and Access Management (IAM) users. For those applications, you
-- must explicitly acknowledge their capabilities by specifying this
-- parameter.
--
-- The only valid values are CAPABILITY_IAM, CAPABILITY_NAMED_IAM,
-- CAPABILITY_RESOURCE_POLICY, and CAPABILITY_AUTO_EXPAND.
--
-- The following resources require you to specify CAPABILITY_IAM or
-- CAPABILITY_NAMED_IAM:
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iam-group.html AWS::IAM::Group>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-instanceprofile.html AWS::IAM::InstanceProfile>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-policy.html AWS::IAM::Policy>,
-- and
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-role.html AWS::IAM::Role>.
-- If the application contains IAM resources, you can specify either
-- CAPABILITY_IAM or CAPABILITY_NAMED_IAM. If the application contains IAM
-- resources with custom names, you must specify CAPABILITY_NAMED_IAM.
--
-- The following resources require you to specify
-- CAPABILITY_RESOURCE_POLICY:
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lambda-permission.html AWS::Lambda::Permission>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-policy.html AWS::IAM:Policy>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-applicationautoscaling-scalingpolicy.html AWS::ApplicationAutoScaling::ScalingPolicy>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-s3-policy.html AWS::S3::BucketPolicy>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sqs-policy.html AWS::SQS::QueuePolicy>,
-- and
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sns-policy.html AWS::SNS::TopicPolicy>.
--
-- Applications that contain one or more nested applications require you to
-- specify CAPABILITY_AUTO_EXPAND.
--
-- If your application template contains any of the above resources, we
-- recommend that you review all permissions associated with the
-- application before deploying. If you don\'t specify this parameter for
-- an application that requires capabilities, the call will fail.
createApplicationVersionResponse_requiredCapabilities :: Lens.Lens' CreateApplicationVersionResponse (Prelude.Maybe [Capability])
createApplicationVersionResponse_requiredCapabilities :: Lens' CreateApplicationVersionResponse (Maybe [Capability])
createApplicationVersionResponse_requiredCapabilities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersionResponse' {Maybe [Capability]
requiredCapabilities :: Maybe [Capability]
$sel:requiredCapabilities:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe [Capability]
requiredCapabilities} -> Maybe [Capability]
requiredCapabilities) (\s :: CreateApplicationVersionResponse
s@CreateApplicationVersionResponse' {} Maybe [Capability]
a -> CreateApplicationVersionResponse
s {$sel:requiredCapabilities:CreateApplicationVersionResponse' :: Maybe [Capability]
requiredCapabilities = Maybe [Capability]
a} :: CreateApplicationVersionResponse) 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

-- | Whether all of the AWS resources contained in this application are
-- supported in the region in which it is being retrieved.
createApplicationVersionResponse_resourcesSupported :: Lens.Lens' CreateApplicationVersionResponse (Prelude.Maybe Prelude.Bool)
createApplicationVersionResponse_resourcesSupported :: Lens' CreateApplicationVersionResponse (Maybe Bool)
createApplicationVersionResponse_resourcesSupported = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersionResponse' {Maybe Bool
resourcesSupported :: Maybe Bool
$sel:resourcesSupported:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Bool
resourcesSupported} -> Maybe Bool
resourcesSupported) (\s :: CreateApplicationVersionResponse
s@CreateApplicationVersionResponse' {} Maybe Bool
a -> CreateApplicationVersionResponse
s {$sel:resourcesSupported:CreateApplicationVersionResponse' :: Maybe Bool
resourcesSupported = Maybe Bool
a} :: CreateApplicationVersionResponse)

-- | The semantic version of the application:
--
-- <https://semver.org/>
createApplicationVersionResponse_semanticVersion :: Lens.Lens' CreateApplicationVersionResponse (Prelude.Maybe Prelude.Text)
createApplicationVersionResponse_semanticVersion :: Lens' CreateApplicationVersionResponse (Maybe Text)
createApplicationVersionResponse_semanticVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersionResponse' {Maybe Text
semanticVersion :: Maybe Text
$sel:semanticVersion:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Text
semanticVersion} -> Maybe Text
semanticVersion) (\s :: CreateApplicationVersionResponse
s@CreateApplicationVersionResponse' {} Maybe Text
a -> CreateApplicationVersionResponse
s {$sel:semanticVersion:CreateApplicationVersionResponse' :: Maybe Text
semanticVersion = Maybe Text
a} :: CreateApplicationVersionResponse)

-- | A link to the S3 object that contains the ZIP archive of the source code
-- for this version of your application.
--
-- Maximum size 50 MB
createApplicationVersionResponse_sourceCodeArchiveUrl :: Lens.Lens' CreateApplicationVersionResponse (Prelude.Maybe Prelude.Text)
createApplicationVersionResponse_sourceCodeArchiveUrl :: Lens' CreateApplicationVersionResponse (Maybe Text)
createApplicationVersionResponse_sourceCodeArchiveUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersionResponse' {Maybe Text
sourceCodeArchiveUrl :: Maybe Text
$sel:sourceCodeArchiveUrl:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Text
sourceCodeArchiveUrl} -> Maybe Text
sourceCodeArchiveUrl) (\s :: CreateApplicationVersionResponse
s@CreateApplicationVersionResponse' {} Maybe Text
a -> CreateApplicationVersionResponse
s {$sel:sourceCodeArchiveUrl:CreateApplicationVersionResponse' :: Maybe Text
sourceCodeArchiveUrl = Maybe Text
a} :: CreateApplicationVersionResponse)

-- | A link to a public repository for the source code of your application,
-- for example the URL of a specific GitHub commit.
createApplicationVersionResponse_sourceCodeUrl :: Lens.Lens' CreateApplicationVersionResponse (Prelude.Maybe Prelude.Text)
createApplicationVersionResponse_sourceCodeUrl :: Lens' CreateApplicationVersionResponse (Maybe Text)
createApplicationVersionResponse_sourceCodeUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersionResponse' {Maybe Text
sourceCodeUrl :: Maybe Text
$sel:sourceCodeUrl:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Text
sourceCodeUrl} -> Maybe Text
sourceCodeUrl) (\s :: CreateApplicationVersionResponse
s@CreateApplicationVersionResponse' {} Maybe Text
a -> CreateApplicationVersionResponse
s {$sel:sourceCodeUrl:CreateApplicationVersionResponse' :: Maybe Text
sourceCodeUrl = Maybe Text
a} :: CreateApplicationVersionResponse)

-- | A link to the packaged AWS SAM template of your application.
createApplicationVersionResponse_templateUrl :: Lens.Lens' CreateApplicationVersionResponse (Prelude.Maybe Prelude.Text)
createApplicationVersionResponse_templateUrl :: Lens' CreateApplicationVersionResponse (Maybe Text)
createApplicationVersionResponse_templateUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApplicationVersionResponse' {Maybe Text
templateUrl :: Maybe Text
$sel:templateUrl:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Text
templateUrl} -> Maybe Text
templateUrl) (\s :: CreateApplicationVersionResponse
s@CreateApplicationVersionResponse' {} Maybe Text
a -> CreateApplicationVersionResponse
s {$sel:templateUrl:CreateApplicationVersionResponse' :: Maybe Text
templateUrl = Maybe Text
a} :: CreateApplicationVersionResponse)

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

instance
  Prelude.NFData
    CreateApplicationVersionResponse
  where
  rnf :: CreateApplicationVersionResponse -> ()
rnf CreateApplicationVersionResponse' {Int
Maybe Bool
Maybe [Capability]
Maybe [ParameterDefinition]
Maybe Text
httpStatus :: Int
templateUrl :: Maybe Text
sourceCodeUrl :: Maybe Text
sourceCodeArchiveUrl :: Maybe Text
semanticVersion :: Maybe Text
resourcesSupported :: Maybe Bool
requiredCapabilities :: Maybe [Capability]
parameterDefinitions :: Maybe [ParameterDefinition]
creationTime :: Maybe Text
applicationId :: Maybe Text
$sel:httpStatus:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Int
$sel:templateUrl:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Text
$sel:sourceCodeUrl:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Text
$sel:sourceCodeArchiveUrl:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Text
$sel:semanticVersion:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Text
$sel:resourcesSupported:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Bool
$sel:requiredCapabilities:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe [Capability]
$sel:parameterDefinitions:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe [ParameterDefinition]
$sel:creationTime:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Text
$sel:applicationId:CreateApplicationVersionResponse' :: CreateApplicationVersionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ParameterDefinition]
parameterDefinitions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Capability]
requiredCapabilities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
resourcesSupported
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
semanticVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceCodeArchiveUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceCodeUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus