{-# 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.CodeBuild.StartBuild
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts running a build.
module Amazonka.CodeBuild.StartBuild
  ( -- * Creating a Request
    StartBuild (..),
    newStartBuild,

    -- * Request Lenses
    startBuild_artifactsOverride,
    startBuild_buildStatusConfigOverride,
    startBuild_buildspecOverride,
    startBuild_cacheOverride,
    startBuild_certificateOverride,
    startBuild_computeTypeOverride,
    startBuild_debugSessionEnabled,
    startBuild_encryptionKeyOverride,
    startBuild_environmentTypeOverride,
    startBuild_environmentVariablesOverride,
    startBuild_gitCloneDepthOverride,
    startBuild_gitSubmodulesConfigOverride,
    startBuild_idempotencyToken,
    startBuild_imageOverride,
    startBuild_imagePullCredentialsTypeOverride,
    startBuild_insecureSslOverride,
    startBuild_logsConfigOverride,
    startBuild_privilegedModeOverride,
    startBuild_queuedTimeoutInMinutesOverride,
    startBuild_registryCredentialOverride,
    startBuild_reportBuildStatusOverride,
    startBuild_secondaryArtifactsOverride,
    startBuild_secondarySourcesOverride,
    startBuild_secondarySourcesVersionOverride,
    startBuild_serviceRoleOverride,
    startBuild_sourceAuthOverride,
    startBuild_sourceLocationOverride,
    startBuild_sourceTypeOverride,
    startBuild_sourceVersion,
    startBuild_timeoutInMinutesOverride,
    startBuild_projectName,

    -- * Destructuring the Response
    StartBuildResponse (..),
    newStartBuildResponse,

    -- * Response Lenses
    startBuildResponse_build,
    startBuildResponse_httpStatus,
  )
where

import Amazonka.CodeBuild.Types
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

-- | /See:/ 'newStartBuild' smart constructor.
data StartBuild = StartBuild'
  { -- | Build output artifact settings that override, for this build only, the
    -- latest ones already defined in the build project.
    StartBuild -> Maybe ProjectArtifacts
artifactsOverride :: Prelude.Maybe ProjectArtifacts,
    -- | Contains information that defines how the build project reports the
    -- build status to the source provider. This option is only used when the
    -- source provider is @GITHUB@, @GITHUB_ENTERPRISE@, or @BITBUCKET@.
    StartBuild -> Maybe BuildStatusConfig
buildStatusConfigOverride :: Prelude.Maybe BuildStatusConfig,
    -- | A buildspec file declaration that overrides, for this build only, the
    -- latest one already defined in the build project.
    --
    -- If this value is set, it can be either an inline buildspec definition,
    -- the path to an alternate buildspec file relative to the value of the
    -- built-in @CODEBUILD_SRC_DIR@ environment variable, or the path to an S3
    -- bucket. The bucket must be in the same Amazon Web Services Region as the
    -- build project. Specify the buildspec file using its ARN (for example,
    -- @arn:aws:s3:::my-codebuild-sample2\/buildspec.yml@). If this value is
    -- not provided or is set to an empty string, the source code must contain
    -- a buildspec file in its root directory. For more information, see
    -- <https://docs.aws.amazon.com/codebuild/latest/userguide/build-spec-ref.html#build-spec-ref-name-storage Buildspec File Name and Storage Location>.
    StartBuild -> Maybe Text
buildspecOverride :: Prelude.Maybe Prelude.Text,
    -- | A ProjectCache object specified for this build that overrides the one
    -- defined in the build project.
    StartBuild -> Maybe ProjectCache
cacheOverride :: Prelude.Maybe ProjectCache,
    -- | The name of a certificate for this build that overrides the one
    -- specified in the build project.
    StartBuild -> Maybe Text
certificateOverride :: Prelude.Maybe Prelude.Text,
    -- | The name of a compute type for this build that overrides the one
    -- specified in the build project.
    StartBuild -> Maybe ComputeType
computeTypeOverride :: Prelude.Maybe ComputeType,
    -- | Specifies if session debugging is enabled for this build. For more
    -- information, see
    -- <https://docs.aws.amazon.com/codebuild/latest/userguide/session-manager.html Viewing a running build in Session Manager>.
    StartBuild -> Maybe Bool
debugSessionEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The Key Management Service customer master key (CMK) that overrides the
    -- one specified in the build project. The CMK key encrypts the build
    -- output artifacts.
    --
    -- You can use a cross-account KMS key to encrypt the build output
    -- artifacts if your service role has permission to that key.
    --
    -- You can specify either the Amazon Resource Name (ARN) of the CMK or, if
    -- available, the CMK\'s alias (using the format @alias\/\<alias-name>@).
    StartBuild -> Maybe Text
encryptionKeyOverride :: Prelude.Maybe Prelude.Text,
    -- | A container type for this build that overrides the one specified in the
    -- build project.
    StartBuild -> Maybe EnvironmentType
environmentTypeOverride :: Prelude.Maybe EnvironmentType,
    -- | A set of environment variables that overrides, for this build only, the
    -- latest ones already defined in the build project.
    StartBuild -> Maybe [EnvironmentVariable]
environmentVariablesOverride :: Prelude.Maybe [EnvironmentVariable],
    -- | The user-defined depth of history, with a minimum value of 0, that
    -- overrides, for this build only, any previous depth of history defined in
    -- the build project.
    StartBuild -> Maybe Natural
gitCloneDepthOverride :: Prelude.Maybe Prelude.Natural,
    -- | Information about the Git submodules configuration for this build of an
    -- CodeBuild build project.
    StartBuild -> Maybe GitSubmodulesConfig
gitSubmodulesConfigOverride :: Prelude.Maybe GitSubmodulesConfig,
    -- | A unique, case sensitive identifier you provide to ensure the
    -- idempotency of the StartBuild request. The token is included in the
    -- StartBuild request and is valid for 5 minutes. If you repeat the
    -- StartBuild request with the same token, but change a parameter,
    -- CodeBuild returns a parameter mismatch error.
    StartBuild -> Maybe Text
idempotencyToken :: Prelude.Maybe Prelude.Text,
    -- | The name of an image for this build that overrides the one specified in
    -- the build project.
    StartBuild -> Maybe Text
imageOverride :: Prelude.Maybe Prelude.Text,
    -- | The type of credentials CodeBuild uses to pull images in your build.
    -- There are two valid values:
    --
    -- [CODEBUILD]
    --     Specifies that CodeBuild uses its own credentials. This requires
    --     that you modify your ECR repository policy to trust CodeBuild\'s
    --     service principal.
    --
    -- [SERVICE_ROLE]
    --     Specifies that CodeBuild uses your build project\'s service role.
    --
    -- When using a cross-account or private registry image, you must use
    -- @SERVICE_ROLE@ credentials. When using an CodeBuild curated image, you
    -- must use @CODEBUILD@ credentials.
    StartBuild -> Maybe ImagePullCredentialsType
imagePullCredentialsTypeOverride :: Prelude.Maybe ImagePullCredentialsType,
    -- | Enable this flag to override the insecure SSL setting that is specified
    -- in the build project. The insecure SSL setting determines whether to
    -- ignore SSL warnings while connecting to the project source code. This
    -- override applies only if the build\'s source is GitHub Enterprise.
    StartBuild -> Maybe Bool
insecureSslOverride :: Prelude.Maybe Prelude.Bool,
    -- | Log settings for this build that override the log settings defined in
    -- the build project.
    StartBuild -> Maybe LogsConfig
logsConfigOverride :: Prelude.Maybe LogsConfig,
    -- | Enable this flag to override privileged mode in the build project.
    StartBuild -> Maybe Bool
privilegedModeOverride :: Prelude.Maybe Prelude.Bool,
    -- | The number of minutes a build is allowed to be queued before it times
    -- out.
    StartBuild -> Maybe Natural
queuedTimeoutInMinutesOverride :: Prelude.Maybe Prelude.Natural,
    -- | The credentials for access to a private registry.
    StartBuild -> Maybe RegistryCredential
registryCredentialOverride :: Prelude.Maybe RegistryCredential,
    -- | Set to true to report to your source provider the status of a build\'s
    -- start and completion. If you use this option with a source provider
    -- other than GitHub, GitHub Enterprise, or Bitbucket, an
    -- @invalidInputException@ is thrown.
    --
    -- To be able to report the build status to the source provider, the user
    -- associated with the source provider must have write access to the repo.
    -- If the user does not have write access, the build status cannot be
    -- updated. For more information, see
    -- <https://docs.aws.amazon.com/codebuild/latest/userguide/access-tokens.html Source provider access>
    -- in the /CodeBuild User Guide/.
    --
    -- The status of a build triggered by a webhook is always reported to your
    -- source provider.
    StartBuild -> Maybe Bool
reportBuildStatusOverride :: Prelude.Maybe Prelude.Bool,
    -- | An array of @ProjectArtifacts@ objects.
    StartBuild -> Maybe [ProjectArtifacts]
secondaryArtifactsOverride :: Prelude.Maybe [ProjectArtifacts],
    -- | An array of @ProjectSource@ objects.
    StartBuild -> Maybe [ProjectSource]
secondarySourcesOverride :: Prelude.Maybe [ProjectSource],
    -- | An array of @ProjectSourceVersion@ objects that specify one or more
    -- versions of the project\'s secondary sources to be used for this build
    -- only.
    StartBuild -> Maybe [ProjectSourceVersion]
secondarySourcesVersionOverride :: Prelude.Maybe [ProjectSourceVersion],
    -- | The name of a service role for this build that overrides the one
    -- specified in the build project.
    StartBuild -> Maybe Text
serviceRoleOverride :: Prelude.Maybe Prelude.Text,
    -- | An authorization type for this build that overrides the one defined in
    -- the build project. This override applies only if the build project\'s
    -- source is BitBucket or GitHub.
    StartBuild -> Maybe SourceAuth
sourceAuthOverride :: Prelude.Maybe SourceAuth,
    -- | A location that overrides, for this build, the source location for the
    -- one defined in the build project.
    StartBuild -> Maybe Text
sourceLocationOverride :: Prelude.Maybe Prelude.Text,
    -- | A source input type, for this build, that overrides the source input
    -- defined in the build project.
    StartBuild -> Maybe SourceType
sourceTypeOverride :: Prelude.Maybe SourceType,
    -- | The version of the build input to be built, for this build only. If not
    -- specified, the latest version is used. If specified, the contents
    -- depends on the source provider:
    --
    -- [CodeCommit]
    --     The commit ID, branch, or Git tag to use.
    --
    -- [GitHub]
    --     The commit ID, pull request ID, branch name, or tag name that
    --     corresponds to the version of the source code you want to build. If
    --     a pull request ID is specified, it must use the format
    --     @pr\/pull-request-ID@ (for example @pr\/25@). If a branch name is
    --     specified, the branch\'s HEAD commit ID is used. If not specified,
    --     the default branch\'s HEAD commit ID is used.
    --
    -- [Bitbucket]
    --     The commit ID, branch name, or tag name that corresponds to the
    --     version of the source code you want to build. If a branch name is
    --     specified, the branch\'s HEAD commit ID is used. If not specified,
    --     the default branch\'s HEAD commit ID is used.
    --
    -- [Amazon S3]
    --     The version ID of the object that represents the build input ZIP
    --     file to use.
    --
    -- If @sourceVersion@ is specified at the project level, then this
    -- @sourceVersion@ (at the build level) takes precedence.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/codebuild/latest/userguide/sample-source-version.html Source Version Sample with CodeBuild>
    -- in the /CodeBuild User Guide/.
    StartBuild -> Maybe Text
sourceVersion :: Prelude.Maybe Prelude.Text,
    -- | The number of build timeout minutes, from 5 to 480 (8 hours), that
    -- overrides, for this build only, the latest setting already defined in
    -- the build project.
    StartBuild -> Maybe Natural
timeoutInMinutesOverride :: Prelude.Maybe Prelude.Natural,
    -- | The name of the CodeBuild build project to start running a build.
    StartBuild -> Text
projectName :: Prelude.Text
  }
  deriving (StartBuild -> StartBuild -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartBuild -> StartBuild -> Bool
$c/= :: StartBuild -> StartBuild -> Bool
== :: StartBuild -> StartBuild -> Bool
$c== :: StartBuild -> StartBuild -> Bool
Prelude.Eq, ReadPrec [StartBuild]
ReadPrec StartBuild
Int -> ReadS StartBuild
ReadS [StartBuild]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartBuild]
$creadListPrec :: ReadPrec [StartBuild]
readPrec :: ReadPrec StartBuild
$creadPrec :: ReadPrec StartBuild
readList :: ReadS [StartBuild]
$creadList :: ReadS [StartBuild]
readsPrec :: Int -> ReadS StartBuild
$creadsPrec :: Int -> ReadS StartBuild
Prelude.Read, Int -> StartBuild -> ShowS
[StartBuild] -> ShowS
StartBuild -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartBuild] -> ShowS
$cshowList :: [StartBuild] -> ShowS
show :: StartBuild -> String
$cshow :: StartBuild -> String
showsPrec :: Int -> StartBuild -> ShowS
$cshowsPrec :: Int -> StartBuild -> ShowS
Prelude.Show, forall x. Rep StartBuild x -> StartBuild
forall x. StartBuild -> Rep StartBuild x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartBuild x -> StartBuild
$cfrom :: forall x. StartBuild -> Rep StartBuild x
Prelude.Generic)

-- |
-- Create a value of 'StartBuild' 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:
--
-- 'artifactsOverride', 'startBuild_artifactsOverride' - Build output artifact settings that override, for this build only, the
-- latest ones already defined in the build project.
--
-- 'buildStatusConfigOverride', 'startBuild_buildStatusConfigOverride' - Contains information that defines how the build project reports the
-- build status to the source provider. This option is only used when the
-- source provider is @GITHUB@, @GITHUB_ENTERPRISE@, or @BITBUCKET@.
--
-- 'buildspecOverride', 'startBuild_buildspecOverride' - A buildspec file declaration that overrides, for this build only, the
-- latest one already defined in the build project.
--
-- If this value is set, it can be either an inline buildspec definition,
-- the path to an alternate buildspec file relative to the value of the
-- built-in @CODEBUILD_SRC_DIR@ environment variable, or the path to an S3
-- bucket. The bucket must be in the same Amazon Web Services Region as the
-- build project. Specify the buildspec file using its ARN (for example,
-- @arn:aws:s3:::my-codebuild-sample2\/buildspec.yml@). If this value is
-- not provided or is set to an empty string, the source code must contain
-- a buildspec file in its root directory. For more information, see
-- <https://docs.aws.amazon.com/codebuild/latest/userguide/build-spec-ref.html#build-spec-ref-name-storage Buildspec File Name and Storage Location>.
--
-- 'cacheOverride', 'startBuild_cacheOverride' - A ProjectCache object specified for this build that overrides the one
-- defined in the build project.
--
-- 'certificateOverride', 'startBuild_certificateOverride' - The name of a certificate for this build that overrides the one
-- specified in the build project.
--
-- 'computeTypeOverride', 'startBuild_computeTypeOverride' - The name of a compute type for this build that overrides the one
-- specified in the build project.
--
-- 'debugSessionEnabled', 'startBuild_debugSessionEnabled' - Specifies if session debugging is enabled for this build. For more
-- information, see
-- <https://docs.aws.amazon.com/codebuild/latest/userguide/session-manager.html Viewing a running build in Session Manager>.
--
-- 'encryptionKeyOverride', 'startBuild_encryptionKeyOverride' - The Key Management Service customer master key (CMK) that overrides the
-- one specified in the build project. The CMK key encrypts the build
-- output artifacts.
--
-- You can use a cross-account KMS key to encrypt the build output
-- artifacts if your service role has permission to that key.
--
-- You can specify either the Amazon Resource Name (ARN) of the CMK or, if
-- available, the CMK\'s alias (using the format @alias\/\<alias-name>@).
--
-- 'environmentTypeOverride', 'startBuild_environmentTypeOverride' - A container type for this build that overrides the one specified in the
-- build project.
--
-- 'environmentVariablesOverride', 'startBuild_environmentVariablesOverride' - A set of environment variables that overrides, for this build only, the
-- latest ones already defined in the build project.
--
-- 'gitCloneDepthOverride', 'startBuild_gitCloneDepthOverride' - The user-defined depth of history, with a minimum value of 0, that
-- overrides, for this build only, any previous depth of history defined in
-- the build project.
--
-- 'gitSubmodulesConfigOverride', 'startBuild_gitSubmodulesConfigOverride' - Information about the Git submodules configuration for this build of an
-- CodeBuild build project.
--
-- 'idempotencyToken', 'startBuild_idempotencyToken' - A unique, case sensitive identifier you provide to ensure the
-- idempotency of the StartBuild request. The token is included in the
-- StartBuild request and is valid for 5 minutes. If you repeat the
-- StartBuild request with the same token, but change a parameter,
-- CodeBuild returns a parameter mismatch error.
--
-- 'imageOverride', 'startBuild_imageOverride' - The name of an image for this build that overrides the one specified in
-- the build project.
--
-- 'imagePullCredentialsTypeOverride', 'startBuild_imagePullCredentialsTypeOverride' - The type of credentials CodeBuild uses to pull images in your build.
-- There are two valid values:
--
-- [CODEBUILD]
--     Specifies that CodeBuild uses its own credentials. This requires
--     that you modify your ECR repository policy to trust CodeBuild\'s
--     service principal.
--
-- [SERVICE_ROLE]
--     Specifies that CodeBuild uses your build project\'s service role.
--
-- When using a cross-account or private registry image, you must use
-- @SERVICE_ROLE@ credentials. When using an CodeBuild curated image, you
-- must use @CODEBUILD@ credentials.
--
-- 'insecureSslOverride', 'startBuild_insecureSslOverride' - Enable this flag to override the insecure SSL setting that is specified
-- in the build project. The insecure SSL setting determines whether to
-- ignore SSL warnings while connecting to the project source code. This
-- override applies only if the build\'s source is GitHub Enterprise.
--
-- 'logsConfigOverride', 'startBuild_logsConfigOverride' - Log settings for this build that override the log settings defined in
-- the build project.
--
-- 'privilegedModeOverride', 'startBuild_privilegedModeOverride' - Enable this flag to override privileged mode in the build project.
--
-- 'queuedTimeoutInMinutesOverride', 'startBuild_queuedTimeoutInMinutesOverride' - The number of minutes a build is allowed to be queued before it times
-- out.
--
-- 'registryCredentialOverride', 'startBuild_registryCredentialOverride' - The credentials for access to a private registry.
--
-- 'reportBuildStatusOverride', 'startBuild_reportBuildStatusOverride' - Set to true to report to your source provider the status of a build\'s
-- start and completion. If you use this option with a source provider
-- other than GitHub, GitHub Enterprise, or Bitbucket, an
-- @invalidInputException@ is thrown.
--
-- To be able to report the build status to the source provider, the user
-- associated with the source provider must have write access to the repo.
-- If the user does not have write access, the build status cannot be
-- updated. For more information, see
-- <https://docs.aws.amazon.com/codebuild/latest/userguide/access-tokens.html Source provider access>
-- in the /CodeBuild User Guide/.
--
-- The status of a build triggered by a webhook is always reported to your
-- source provider.
--
-- 'secondaryArtifactsOverride', 'startBuild_secondaryArtifactsOverride' - An array of @ProjectArtifacts@ objects.
--
-- 'secondarySourcesOverride', 'startBuild_secondarySourcesOverride' - An array of @ProjectSource@ objects.
--
-- 'secondarySourcesVersionOverride', 'startBuild_secondarySourcesVersionOverride' - An array of @ProjectSourceVersion@ objects that specify one or more
-- versions of the project\'s secondary sources to be used for this build
-- only.
--
-- 'serviceRoleOverride', 'startBuild_serviceRoleOverride' - The name of a service role for this build that overrides the one
-- specified in the build project.
--
-- 'sourceAuthOverride', 'startBuild_sourceAuthOverride' - An authorization type for this build that overrides the one defined in
-- the build project. This override applies only if the build project\'s
-- source is BitBucket or GitHub.
--
-- 'sourceLocationOverride', 'startBuild_sourceLocationOverride' - A location that overrides, for this build, the source location for the
-- one defined in the build project.
--
-- 'sourceTypeOverride', 'startBuild_sourceTypeOverride' - A source input type, for this build, that overrides the source input
-- defined in the build project.
--
-- 'sourceVersion', 'startBuild_sourceVersion' - The version of the build input to be built, for this build only. If not
-- specified, the latest version is used. If specified, the contents
-- depends on the source provider:
--
-- [CodeCommit]
--     The commit ID, branch, or Git tag to use.
--
-- [GitHub]
--     The commit ID, pull request ID, branch name, or tag name that
--     corresponds to the version of the source code you want to build. If
--     a pull request ID is specified, it must use the format
--     @pr\/pull-request-ID@ (for example @pr\/25@). If a branch name is
--     specified, the branch\'s HEAD commit ID is used. If not specified,
--     the default branch\'s HEAD commit ID is used.
--
-- [Bitbucket]
--     The commit ID, branch name, or tag name that corresponds to the
--     version of the source code you want to build. If a branch name is
--     specified, the branch\'s HEAD commit ID is used. If not specified,
--     the default branch\'s HEAD commit ID is used.
--
-- [Amazon S3]
--     The version ID of the object that represents the build input ZIP
--     file to use.
--
-- If @sourceVersion@ is specified at the project level, then this
-- @sourceVersion@ (at the build level) takes precedence.
--
-- For more information, see
-- <https://docs.aws.amazon.com/codebuild/latest/userguide/sample-source-version.html Source Version Sample with CodeBuild>
-- in the /CodeBuild User Guide/.
--
-- 'timeoutInMinutesOverride', 'startBuild_timeoutInMinutesOverride' - The number of build timeout minutes, from 5 to 480 (8 hours), that
-- overrides, for this build only, the latest setting already defined in
-- the build project.
--
-- 'projectName', 'startBuild_projectName' - The name of the CodeBuild build project to start running a build.
newStartBuild ::
  -- | 'projectName'
  Prelude.Text ->
  StartBuild
newStartBuild :: Text -> StartBuild
newStartBuild Text
pProjectName_ =
  StartBuild'
    { $sel:artifactsOverride:StartBuild' :: Maybe ProjectArtifacts
artifactsOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:buildStatusConfigOverride:StartBuild' :: Maybe BuildStatusConfig
buildStatusConfigOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:buildspecOverride:StartBuild' :: Maybe Text
buildspecOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:cacheOverride:StartBuild' :: Maybe ProjectCache
cacheOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:certificateOverride:StartBuild' :: Maybe Text
certificateOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:computeTypeOverride:StartBuild' :: Maybe ComputeType
computeTypeOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:debugSessionEnabled:StartBuild' :: Maybe Bool
debugSessionEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionKeyOverride:StartBuild' :: Maybe Text
encryptionKeyOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:environmentTypeOverride:StartBuild' :: Maybe EnvironmentType
environmentTypeOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:environmentVariablesOverride:StartBuild' :: Maybe [EnvironmentVariable]
environmentVariablesOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:gitCloneDepthOverride:StartBuild' :: Maybe Natural
gitCloneDepthOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:gitSubmodulesConfigOverride:StartBuild' :: Maybe GitSubmodulesConfig
gitSubmodulesConfigOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:idempotencyToken:StartBuild' :: Maybe Text
idempotencyToken = forall a. Maybe a
Prelude.Nothing,
      $sel:imageOverride:StartBuild' :: Maybe Text
imageOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:imagePullCredentialsTypeOverride:StartBuild' :: Maybe ImagePullCredentialsType
imagePullCredentialsTypeOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:insecureSslOverride:StartBuild' :: Maybe Bool
insecureSslOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:logsConfigOverride:StartBuild' :: Maybe LogsConfig
logsConfigOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:privilegedModeOverride:StartBuild' :: Maybe Bool
privilegedModeOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:queuedTimeoutInMinutesOverride:StartBuild' :: Maybe Natural
queuedTimeoutInMinutesOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:registryCredentialOverride:StartBuild' :: Maybe RegistryCredential
registryCredentialOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:reportBuildStatusOverride:StartBuild' :: Maybe Bool
reportBuildStatusOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:secondaryArtifactsOverride:StartBuild' :: Maybe [ProjectArtifacts]
secondaryArtifactsOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:secondarySourcesOverride:StartBuild' :: Maybe [ProjectSource]
secondarySourcesOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:secondarySourcesVersionOverride:StartBuild' :: Maybe [ProjectSourceVersion]
secondarySourcesVersionOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceRoleOverride:StartBuild' :: Maybe Text
serviceRoleOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceAuthOverride:StartBuild' :: Maybe SourceAuth
sourceAuthOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceLocationOverride:StartBuild' :: Maybe Text
sourceLocationOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceTypeOverride:StartBuild' :: Maybe SourceType
sourceTypeOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceVersion:StartBuild' :: Maybe Text
sourceVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:timeoutInMinutesOverride:StartBuild' :: Maybe Natural
timeoutInMinutesOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:projectName:StartBuild' :: Text
projectName = Text
pProjectName_
    }

-- | Build output artifact settings that override, for this build only, the
-- latest ones already defined in the build project.
startBuild_artifactsOverride :: Lens.Lens' StartBuild (Prelude.Maybe ProjectArtifacts)
startBuild_artifactsOverride :: Lens' StartBuild (Maybe ProjectArtifacts)
startBuild_artifactsOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe ProjectArtifacts
artifactsOverride :: Maybe ProjectArtifacts
$sel:artifactsOverride:StartBuild' :: StartBuild -> Maybe ProjectArtifacts
artifactsOverride} -> Maybe ProjectArtifacts
artifactsOverride) (\s :: StartBuild
s@StartBuild' {} Maybe ProjectArtifacts
a -> StartBuild
s {$sel:artifactsOverride:StartBuild' :: Maybe ProjectArtifacts
artifactsOverride = Maybe ProjectArtifacts
a} :: StartBuild)

-- | Contains information that defines how the build project reports the
-- build status to the source provider. This option is only used when the
-- source provider is @GITHUB@, @GITHUB_ENTERPRISE@, or @BITBUCKET@.
startBuild_buildStatusConfigOverride :: Lens.Lens' StartBuild (Prelude.Maybe BuildStatusConfig)
startBuild_buildStatusConfigOverride :: Lens' StartBuild (Maybe BuildStatusConfig)
startBuild_buildStatusConfigOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe BuildStatusConfig
buildStatusConfigOverride :: Maybe BuildStatusConfig
$sel:buildStatusConfigOverride:StartBuild' :: StartBuild -> Maybe BuildStatusConfig
buildStatusConfigOverride} -> Maybe BuildStatusConfig
buildStatusConfigOverride) (\s :: StartBuild
s@StartBuild' {} Maybe BuildStatusConfig
a -> StartBuild
s {$sel:buildStatusConfigOverride:StartBuild' :: Maybe BuildStatusConfig
buildStatusConfigOverride = Maybe BuildStatusConfig
a} :: StartBuild)

-- | A buildspec file declaration that overrides, for this build only, the
-- latest one already defined in the build project.
--
-- If this value is set, it can be either an inline buildspec definition,
-- the path to an alternate buildspec file relative to the value of the
-- built-in @CODEBUILD_SRC_DIR@ environment variable, or the path to an S3
-- bucket. The bucket must be in the same Amazon Web Services Region as the
-- build project. Specify the buildspec file using its ARN (for example,
-- @arn:aws:s3:::my-codebuild-sample2\/buildspec.yml@). If this value is
-- not provided or is set to an empty string, the source code must contain
-- a buildspec file in its root directory. For more information, see
-- <https://docs.aws.amazon.com/codebuild/latest/userguide/build-spec-ref.html#build-spec-ref-name-storage Buildspec File Name and Storage Location>.
startBuild_buildspecOverride :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Text)
startBuild_buildspecOverride :: Lens' StartBuild (Maybe Text)
startBuild_buildspecOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Text
buildspecOverride :: Maybe Text
$sel:buildspecOverride:StartBuild' :: StartBuild -> Maybe Text
buildspecOverride} -> Maybe Text
buildspecOverride) (\s :: StartBuild
s@StartBuild' {} Maybe Text
a -> StartBuild
s {$sel:buildspecOverride:StartBuild' :: Maybe Text
buildspecOverride = Maybe Text
a} :: StartBuild)

-- | A ProjectCache object specified for this build that overrides the one
-- defined in the build project.
startBuild_cacheOverride :: Lens.Lens' StartBuild (Prelude.Maybe ProjectCache)
startBuild_cacheOverride :: Lens' StartBuild (Maybe ProjectCache)
startBuild_cacheOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe ProjectCache
cacheOverride :: Maybe ProjectCache
$sel:cacheOverride:StartBuild' :: StartBuild -> Maybe ProjectCache
cacheOverride} -> Maybe ProjectCache
cacheOverride) (\s :: StartBuild
s@StartBuild' {} Maybe ProjectCache
a -> StartBuild
s {$sel:cacheOverride:StartBuild' :: Maybe ProjectCache
cacheOverride = Maybe ProjectCache
a} :: StartBuild)

-- | The name of a certificate for this build that overrides the one
-- specified in the build project.
startBuild_certificateOverride :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Text)
startBuild_certificateOverride :: Lens' StartBuild (Maybe Text)
startBuild_certificateOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Text
certificateOverride :: Maybe Text
$sel:certificateOverride:StartBuild' :: StartBuild -> Maybe Text
certificateOverride} -> Maybe Text
certificateOverride) (\s :: StartBuild
s@StartBuild' {} Maybe Text
a -> StartBuild
s {$sel:certificateOverride:StartBuild' :: Maybe Text
certificateOverride = Maybe Text
a} :: StartBuild)

-- | The name of a compute type for this build that overrides the one
-- specified in the build project.
startBuild_computeTypeOverride :: Lens.Lens' StartBuild (Prelude.Maybe ComputeType)
startBuild_computeTypeOverride :: Lens' StartBuild (Maybe ComputeType)
startBuild_computeTypeOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe ComputeType
computeTypeOverride :: Maybe ComputeType
$sel:computeTypeOverride:StartBuild' :: StartBuild -> Maybe ComputeType
computeTypeOverride} -> Maybe ComputeType
computeTypeOverride) (\s :: StartBuild
s@StartBuild' {} Maybe ComputeType
a -> StartBuild
s {$sel:computeTypeOverride:StartBuild' :: Maybe ComputeType
computeTypeOverride = Maybe ComputeType
a} :: StartBuild)

-- | Specifies if session debugging is enabled for this build. For more
-- information, see
-- <https://docs.aws.amazon.com/codebuild/latest/userguide/session-manager.html Viewing a running build in Session Manager>.
startBuild_debugSessionEnabled :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Bool)
startBuild_debugSessionEnabled :: Lens' StartBuild (Maybe Bool)
startBuild_debugSessionEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Bool
debugSessionEnabled :: Maybe Bool
$sel:debugSessionEnabled:StartBuild' :: StartBuild -> Maybe Bool
debugSessionEnabled} -> Maybe Bool
debugSessionEnabled) (\s :: StartBuild
s@StartBuild' {} Maybe Bool
a -> StartBuild
s {$sel:debugSessionEnabled:StartBuild' :: Maybe Bool
debugSessionEnabled = Maybe Bool
a} :: StartBuild)

-- | The Key Management Service customer master key (CMK) that overrides the
-- one specified in the build project. The CMK key encrypts the build
-- output artifacts.
--
-- You can use a cross-account KMS key to encrypt the build output
-- artifacts if your service role has permission to that key.
--
-- You can specify either the Amazon Resource Name (ARN) of the CMK or, if
-- available, the CMK\'s alias (using the format @alias\/\<alias-name>@).
startBuild_encryptionKeyOverride :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Text)
startBuild_encryptionKeyOverride :: Lens' StartBuild (Maybe Text)
startBuild_encryptionKeyOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Text
encryptionKeyOverride :: Maybe Text
$sel:encryptionKeyOverride:StartBuild' :: StartBuild -> Maybe Text
encryptionKeyOverride} -> Maybe Text
encryptionKeyOverride) (\s :: StartBuild
s@StartBuild' {} Maybe Text
a -> StartBuild
s {$sel:encryptionKeyOverride:StartBuild' :: Maybe Text
encryptionKeyOverride = Maybe Text
a} :: StartBuild)

-- | A container type for this build that overrides the one specified in the
-- build project.
startBuild_environmentTypeOverride :: Lens.Lens' StartBuild (Prelude.Maybe EnvironmentType)
startBuild_environmentTypeOverride :: Lens' StartBuild (Maybe EnvironmentType)
startBuild_environmentTypeOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe EnvironmentType
environmentTypeOverride :: Maybe EnvironmentType
$sel:environmentTypeOverride:StartBuild' :: StartBuild -> Maybe EnvironmentType
environmentTypeOverride} -> Maybe EnvironmentType
environmentTypeOverride) (\s :: StartBuild
s@StartBuild' {} Maybe EnvironmentType
a -> StartBuild
s {$sel:environmentTypeOverride:StartBuild' :: Maybe EnvironmentType
environmentTypeOverride = Maybe EnvironmentType
a} :: StartBuild)

-- | A set of environment variables that overrides, for this build only, the
-- latest ones already defined in the build project.
startBuild_environmentVariablesOverride :: Lens.Lens' StartBuild (Prelude.Maybe [EnvironmentVariable])
startBuild_environmentVariablesOverride :: Lens' StartBuild (Maybe [EnvironmentVariable])
startBuild_environmentVariablesOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe [EnvironmentVariable]
environmentVariablesOverride :: Maybe [EnvironmentVariable]
$sel:environmentVariablesOverride:StartBuild' :: StartBuild -> Maybe [EnvironmentVariable]
environmentVariablesOverride} -> Maybe [EnvironmentVariable]
environmentVariablesOverride) (\s :: StartBuild
s@StartBuild' {} Maybe [EnvironmentVariable]
a -> StartBuild
s {$sel:environmentVariablesOverride:StartBuild' :: Maybe [EnvironmentVariable]
environmentVariablesOverride = Maybe [EnvironmentVariable]
a} :: StartBuild) 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 user-defined depth of history, with a minimum value of 0, that
-- overrides, for this build only, any previous depth of history defined in
-- the build project.
startBuild_gitCloneDepthOverride :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Natural)
startBuild_gitCloneDepthOverride :: Lens' StartBuild (Maybe Natural)
startBuild_gitCloneDepthOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Natural
gitCloneDepthOverride :: Maybe Natural
$sel:gitCloneDepthOverride:StartBuild' :: StartBuild -> Maybe Natural
gitCloneDepthOverride} -> Maybe Natural
gitCloneDepthOverride) (\s :: StartBuild
s@StartBuild' {} Maybe Natural
a -> StartBuild
s {$sel:gitCloneDepthOverride:StartBuild' :: Maybe Natural
gitCloneDepthOverride = Maybe Natural
a} :: StartBuild)

-- | Information about the Git submodules configuration for this build of an
-- CodeBuild build project.
startBuild_gitSubmodulesConfigOverride :: Lens.Lens' StartBuild (Prelude.Maybe GitSubmodulesConfig)
startBuild_gitSubmodulesConfigOverride :: Lens' StartBuild (Maybe GitSubmodulesConfig)
startBuild_gitSubmodulesConfigOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe GitSubmodulesConfig
gitSubmodulesConfigOverride :: Maybe GitSubmodulesConfig
$sel:gitSubmodulesConfigOverride:StartBuild' :: StartBuild -> Maybe GitSubmodulesConfig
gitSubmodulesConfigOverride} -> Maybe GitSubmodulesConfig
gitSubmodulesConfigOverride) (\s :: StartBuild
s@StartBuild' {} Maybe GitSubmodulesConfig
a -> StartBuild
s {$sel:gitSubmodulesConfigOverride:StartBuild' :: Maybe GitSubmodulesConfig
gitSubmodulesConfigOverride = Maybe GitSubmodulesConfig
a} :: StartBuild)

-- | A unique, case sensitive identifier you provide to ensure the
-- idempotency of the StartBuild request. The token is included in the
-- StartBuild request and is valid for 5 minutes. If you repeat the
-- StartBuild request with the same token, but change a parameter,
-- CodeBuild returns a parameter mismatch error.
startBuild_idempotencyToken :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Text)
startBuild_idempotencyToken :: Lens' StartBuild (Maybe Text)
startBuild_idempotencyToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Text
idempotencyToken :: Maybe Text
$sel:idempotencyToken:StartBuild' :: StartBuild -> Maybe Text
idempotencyToken} -> Maybe Text
idempotencyToken) (\s :: StartBuild
s@StartBuild' {} Maybe Text
a -> StartBuild
s {$sel:idempotencyToken:StartBuild' :: Maybe Text
idempotencyToken = Maybe Text
a} :: StartBuild)

-- | The name of an image for this build that overrides the one specified in
-- the build project.
startBuild_imageOverride :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Text)
startBuild_imageOverride :: Lens' StartBuild (Maybe Text)
startBuild_imageOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Text
imageOverride :: Maybe Text
$sel:imageOverride:StartBuild' :: StartBuild -> Maybe Text
imageOverride} -> Maybe Text
imageOverride) (\s :: StartBuild
s@StartBuild' {} Maybe Text
a -> StartBuild
s {$sel:imageOverride:StartBuild' :: Maybe Text
imageOverride = Maybe Text
a} :: StartBuild)

-- | The type of credentials CodeBuild uses to pull images in your build.
-- There are two valid values:
--
-- [CODEBUILD]
--     Specifies that CodeBuild uses its own credentials. This requires
--     that you modify your ECR repository policy to trust CodeBuild\'s
--     service principal.
--
-- [SERVICE_ROLE]
--     Specifies that CodeBuild uses your build project\'s service role.
--
-- When using a cross-account or private registry image, you must use
-- @SERVICE_ROLE@ credentials. When using an CodeBuild curated image, you
-- must use @CODEBUILD@ credentials.
startBuild_imagePullCredentialsTypeOverride :: Lens.Lens' StartBuild (Prelude.Maybe ImagePullCredentialsType)
startBuild_imagePullCredentialsTypeOverride :: Lens' StartBuild (Maybe ImagePullCredentialsType)
startBuild_imagePullCredentialsTypeOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe ImagePullCredentialsType
imagePullCredentialsTypeOverride :: Maybe ImagePullCredentialsType
$sel:imagePullCredentialsTypeOverride:StartBuild' :: StartBuild -> Maybe ImagePullCredentialsType
imagePullCredentialsTypeOverride} -> Maybe ImagePullCredentialsType
imagePullCredentialsTypeOverride) (\s :: StartBuild
s@StartBuild' {} Maybe ImagePullCredentialsType
a -> StartBuild
s {$sel:imagePullCredentialsTypeOverride:StartBuild' :: Maybe ImagePullCredentialsType
imagePullCredentialsTypeOverride = Maybe ImagePullCredentialsType
a} :: StartBuild)

-- | Enable this flag to override the insecure SSL setting that is specified
-- in the build project. The insecure SSL setting determines whether to
-- ignore SSL warnings while connecting to the project source code. This
-- override applies only if the build\'s source is GitHub Enterprise.
startBuild_insecureSslOverride :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Bool)
startBuild_insecureSslOverride :: Lens' StartBuild (Maybe Bool)
startBuild_insecureSslOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Bool
insecureSslOverride :: Maybe Bool
$sel:insecureSslOverride:StartBuild' :: StartBuild -> Maybe Bool
insecureSslOverride} -> Maybe Bool
insecureSslOverride) (\s :: StartBuild
s@StartBuild' {} Maybe Bool
a -> StartBuild
s {$sel:insecureSslOverride:StartBuild' :: Maybe Bool
insecureSslOverride = Maybe Bool
a} :: StartBuild)

-- | Log settings for this build that override the log settings defined in
-- the build project.
startBuild_logsConfigOverride :: Lens.Lens' StartBuild (Prelude.Maybe LogsConfig)
startBuild_logsConfigOverride :: Lens' StartBuild (Maybe LogsConfig)
startBuild_logsConfigOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe LogsConfig
logsConfigOverride :: Maybe LogsConfig
$sel:logsConfigOverride:StartBuild' :: StartBuild -> Maybe LogsConfig
logsConfigOverride} -> Maybe LogsConfig
logsConfigOverride) (\s :: StartBuild
s@StartBuild' {} Maybe LogsConfig
a -> StartBuild
s {$sel:logsConfigOverride:StartBuild' :: Maybe LogsConfig
logsConfigOverride = Maybe LogsConfig
a} :: StartBuild)

-- | Enable this flag to override privileged mode in the build project.
startBuild_privilegedModeOverride :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Bool)
startBuild_privilegedModeOverride :: Lens' StartBuild (Maybe Bool)
startBuild_privilegedModeOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Bool
privilegedModeOverride :: Maybe Bool
$sel:privilegedModeOverride:StartBuild' :: StartBuild -> Maybe Bool
privilegedModeOverride} -> Maybe Bool
privilegedModeOverride) (\s :: StartBuild
s@StartBuild' {} Maybe Bool
a -> StartBuild
s {$sel:privilegedModeOverride:StartBuild' :: Maybe Bool
privilegedModeOverride = Maybe Bool
a} :: StartBuild)

-- | The number of minutes a build is allowed to be queued before it times
-- out.
startBuild_queuedTimeoutInMinutesOverride :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Natural)
startBuild_queuedTimeoutInMinutesOverride :: Lens' StartBuild (Maybe Natural)
startBuild_queuedTimeoutInMinutesOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Natural
queuedTimeoutInMinutesOverride :: Maybe Natural
$sel:queuedTimeoutInMinutesOverride:StartBuild' :: StartBuild -> Maybe Natural
queuedTimeoutInMinutesOverride} -> Maybe Natural
queuedTimeoutInMinutesOverride) (\s :: StartBuild
s@StartBuild' {} Maybe Natural
a -> StartBuild
s {$sel:queuedTimeoutInMinutesOverride:StartBuild' :: Maybe Natural
queuedTimeoutInMinutesOverride = Maybe Natural
a} :: StartBuild)

-- | The credentials for access to a private registry.
startBuild_registryCredentialOverride :: Lens.Lens' StartBuild (Prelude.Maybe RegistryCredential)
startBuild_registryCredentialOverride :: Lens' StartBuild (Maybe RegistryCredential)
startBuild_registryCredentialOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe RegistryCredential
registryCredentialOverride :: Maybe RegistryCredential
$sel:registryCredentialOverride:StartBuild' :: StartBuild -> Maybe RegistryCredential
registryCredentialOverride} -> Maybe RegistryCredential
registryCredentialOverride) (\s :: StartBuild
s@StartBuild' {} Maybe RegistryCredential
a -> StartBuild
s {$sel:registryCredentialOverride:StartBuild' :: Maybe RegistryCredential
registryCredentialOverride = Maybe RegistryCredential
a} :: StartBuild)

-- | Set to true to report to your source provider the status of a build\'s
-- start and completion. If you use this option with a source provider
-- other than GitHub, GitHub Enterprise, or Bitbucket, an
-- @invalidInputException@ is thrown.
--
-- To be able to report the build status to the source provider, the user
-- associated with the source provider must have write access to the repo.
-- If the user does not have write access, the build status cannot be
-- updated. For more information, see
-- <https://docs.aws.amazon.com/codebuild/latest/userguide/access-tokens.html Source provider access>
-- in the /CodeBuild User Guide/.
--
-- The status of a build triggered by a webhook is always reported to your
-- source provider.
startBuild_reportBuildStatusOverride :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Bool)
startBuild_reportBuildStatusOverride :: Lens' StartBuild (Maybe Bool)
startBuild_reportBuildStatusOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Bool
reportBuildStatusOverride :: Maybe Bool
$sel:reportBuildStatusOverride:StartBuild' :: StartBuild -> Maybe Bool
reportBuildStatusOverride} -> Maybe Bool
reportBuildStatusOverride) (\s :: StartBuild
s@StartBuild' {} Maybe Bool
a -> StartBuild
s {$sel:reportBuildStatusOverride:StartBuild' :: Maybe Bool
reportBuildStatusOverride = Maybe Bool
a} :: StartBuild)

-- | An array of @ProjectArtifacts@ objects.
startBuild_secondaryArtifactsOverride :: Lens.Lens' StartBuild (Prelude.Maybe [ProjectArtifacts])
startBuild_secondaryArtifactsOverride :: Lens' StartBuild (Maybe [ProjectArtifacts])
startBuild_secondaryArtifactsOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe [ProjectArtifacts]
secondaryArtifactsOverride :: Maybe [ProjectArtifacts]
$sel:secondaryArtifactsOverride:StartBuild' :: StartBuild -> Maybe [ProjectArtifacts]
secondaryArtifactsOverride} -> Maybe [ProjectArtifacts]
secondaryArtifactsOverride) (\s :: StartBuild
s@StartBuild' {} Maybe [ProjectArtifacts]
a -> StartBuild
s {$sel:secondaryArtifactsOverride:StartBuild' :: Maybe [ProjectArtifacts]
secondaryArtifactsOverride = Maybe [ProjectArtifacts]
a} :: StartBuild) 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

-- | An array of @ProjectSource@ objects.
startBuild_secondarySourcesOverride :: Lens.Lens' StartBuild (Prelude.Maybe [ProjectSource])
startBuild_secondarySourcesOverride :: Lens' StartBuild (Maybe [ProjectSource])
startBuild_secondarySourcesOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe [ProjectSource]
secondarySourcesOverride :: Maybe [ProjectSource]
$sel:secondarySourcesOverride:StartBuild' :: StartBuild -> Maybe [ProjectSource]
secondarySourcesOverride} -> Maybe [ProjectSource]
secondarySourcesOverride) (\s :: StartBuild
s@StartBuild' {} Maybe [ProjectSource]
a -> StartBuild
s {$sel:secondarySourcesOverride:StartBuild' :: Maybe [ProjectSource]
secondarySourcesOverride = Maybe [ProjectSource]
a} :: StartBuild) 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

-- | An array of @ProjectSourceVersion@ objects that specify one or more
-- versions of the project\'s secondary sources to be used for this build
-- only.
startBuild_secondarySourcesVersionOverride :: Lens.Lens' StartBuild (Prelude.Maybe [ProjectSourceVersion])
startBuild_secondarySourcesVersionOverride :: Lens' StartBuild (Maybe [ProjectSourceVersion])
startBuild_secondarySourcesVersionOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe [ProjectSourceVersion]
secondarySourcesVersionOverride :: Maybe [ProjectSourceVersion]
$sel:secondarySourcesVersionOverride:StartBuild' :: StartBuild -> Maybe [ProjectSourceVersion]
secondarySourcesVersionOverride} -> Maybe [ProjectSourceVersion]
secondarySourcesVersionOverride) (\s :: StartBuild
s@StartBuild' {} Maybe [ProjectSourceVersion]
a -> StartBuild
s {$sel:secondarySourcesVersionOverride:StartBuild' :: Maybe [ProjectSourceVersion]
secondarySourcesVersionOverride = Maybe [ProjectSourceVersion]
a} :: StartBuild) 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 a service role for this build that overrides the one
-- specified in the build project.
startBuild_serviceRoleOverride :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Text)
startBuild_serviceRoleOverride :: Lens' StartBuild (Maybe Text)
startBuild_serviceRoleOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Text
serviceRoleOverride :: Maybe Text
$sel:serviceRoleOverride:StartBuild' :: StartBuild -> Maybe Text
serviceRoleOverride} -> Maybe Text
serviceRoleOverride) (\s :: StartBuild
s@StartBuild' {} Maybe Text
a -> StartBuild
s {$sel:serviceRoleOverride:StartBuild' :: Maybe Text
serviceRoleOverride = Maybe Text
a} :: StartBuild)

-- | An authorization type for this build that overrides the one defined in
-- the build project. This override applies only if the build project\'s
-- source is BitBucket or GitHub.
startBuild_sourceAuthOverride :: Lens.Lens' StartBuild (Prelude.Maybe SourceAuth)
startBuild_sourceAuthOverride :: Lens' StartBuild (Maybe SourceAuth)
startBuild_sourceAuthOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe SourceAuth
sourceAuthOverride :: Maybe SourceAuth
$sel:sourceAuthOverride:StartBuild' :: StartBuild -> Maybe SourceAuth
sourceAuthOverride} -> Maybe SourceAuth
sourceAuthOverride) (\s :: StartBuild
s@StartBuild' {} Maybe SourceAuth
a -> StartBuild
s {$sel:sourceAuthOverride:StartBuild' :: Maybe SourceAuth
sourceAuthOverride = Maybe SourceAuth
a} :: StartBuild)

-- | A location that overrides, for this build, the source location for the
-- one defined in the build project.
startBuild_sourceLocationOverride :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Text)
startBuild_sourceLocationOverride :: Lens' StartBuild (Maybe Text)
startBuild_sourceLocationOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Text
sourceLocationOverride :: Maybe Text
$sel:sourceLocationOverride:StartBuild' :: StartBuild -> Maybe Text
sourceLocationOverride} -> Maybe Text
sourceLocationOverride) (\s :: StartBuild
s@StartBuild' {} Maybe Text
a -> StartBuild
s {$sel:sourceLocationOverride:StartBuild' :: Maybe Text
sourceLocationOverride = Maybe Text
a} :: StartBuild)

-- | A source input type, for this build, that overrides the source input
-- defined in the build project.
startBuild_sourceTypeOverride :: Lens.Lens' StartBuild (Prelude.Maybe SourceType)
startBuild_sourceTypeOverride :: Lens' StartBuild (Maybe SourceType)
startBuild_sourceTypeOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe SourceType
sourceTypeOverride :: Maybe SourceType
$sel:sourceTypeOverride:StartBuild' :: StartBuild -> Maybe SourceType
sourceTypeOverride} -> Maybe SourceType
sourceTypeOverride) (\s :: StartBuild
s@StartBuild' {} Maybe SourceType
a -> StartBuild
s {$sel:sourceTypeOverride:StartBuild' :: Maybe SourceType
sourceTypeOverride = Maybe SourceType
a} :: StartBuild)

-- | The version of the build input to be built, for this build only. If not
-- specified, the latest version is used. If specified, the contents
-- depends on the source provider:
--
-- [CodeCommit]
--     The commit ID, branch, or Git tag to use.
--
-- [GitHub]
--     The commit ID, pull request ID, branch name, or tag name that
--     corresponds to the version of the source code you want to build. If
--     a pull request ID is specified, it must use the format
--     @pr\/pull-request-ID@ (for example @pr\/25@). If a branch name is
--     specified, the branch\'s HEAD commit ID is used. If not specified,
--     the default branch\'s HEAD commit ID is used.
--
-- [Bitbucket]
--     The commit ID, branch name, or tag name that corresponds to the
--     version of the source code you want to build. If a branch name is
--     specified, the branch\'s HEAD commit ID is used. If not specified,
--     the default branch\'s HEAD commit ID is used.
--
-- [Amazon S3]
--     The version ID of the object that represents the build input ZIP
--     file to use.
--
-- If @sourceVersion@ is specified at the project level, then this
-- @sourceVersion@ (at the build level) takes precedence.
--
-- For more information, see
-- <https://docs.aws.amazon.com/codebuild/latest/userguide/sample-source-version.html Source Version Sample with CodeBuild>
-- in the /CodeBuild User Guide/.
startBuild_sourceVersion :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Text)
startBuild_sourceVersion :: Lens' StartBuild (Maybe Text)
startBuild_sourceVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Text
sourceVersion :: Maybe Text
$sel:sourceVersion:StartBuild' :: StartBuild -> Maybe Text
sourceVersion} -> Maybe Text
sourceVersion) (\s :: StartBuild
s@StartBuild' {} Maybe Text
a -> StartBuild
s {$sel:sourceVersion:StartBuild' :: Maybe Text
sourceVersion = Maybe Text
a} :: StartBuild)

-- | The number of build timeout minutes, from 5 to 480 (8 hours), that
-- overrides, for this build only, the latest setting already defined in
-- the build project.
startBuild_timeoutInMinutesOverride :: Lens.Lens' StartBuild (Prelude.Maybe Prelude.Natural)
startBuild_timeoutInMinutesOverride :: Lens' StartBuild (Maybe Natural)
startBuild_timeoutInMinutesOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Maybe Natural
timeoutInMinutesOverride :: Maybe Natural
$sel:timeoutInMinutesOverride:StartBuild' :: StartBuild -> Maybe Natural
timeoutInMinutesOverride} -> Maybe Natural
timeoutInMinutesOverride) (\s :: StartBuild
s@StartBuild' {} Maybe Natural
a -> StartBuild
s {$sel:timeoutInMinutesOverride:StartBuild' :: Maybe Natural
timeoutInMinutesOverride = Maybe Natural
a} :: StartBuild)

-- | The name of the CodeBuild build project to start running a build.
startBuild_projectName :: Lens.Lens' StartBuild Prelude.Text
startBuild_projectName :: Lens' StartBuild Text
startBuild_projectName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuild' {Text
projectName :: Text
$sel:projectName:StartBuild' :: StartBuild -> Text
projectName} -> Text
projectName) (\s :: StartBuild
s@StartBuild' {} Text
a -> StartBuild
s {$sel:projectName:StartBuild' :: Text
projectName = Text
a} :: StartBuild)

instance Core.AWSRequest StartBuild where
  type AWSResponse StartBuild = StartBuildResponse
  request :: (Service -> Service) -> StartBuild -> Request StartBuild
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy StartBuild
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartBuild)))
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 Build -> Int -> StartBuildResponse
StartBuildResponse'
            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
"build")
            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 StartBuild where
  hashWithSalt :: Int -> StartBuild -> Int
hashWithSalt Int
_salt StartBuild' {Maybe Bool
Maybe Natural
Maybe [EnvironmentVariable]
Maybe [ProjectArtifacts]
Maybe [ProjectSourceVersion]
Maybe [ProjectSource]
Maybe Text
Maybe BuildStatusConfig
Maybe ComputeType
Maybe EnvironmentType
Maybe GitSubmodulesConfig
Maybe ImagePullCredentialsType
Maybe ProjectArtifacts
Maybe ProjectCache
Maybe RegistryCredential
Maybe LogsConfig
Maybe SourceAuth
Maybe SourceType
Text
projectName :: Text
timeoutInMinutesOverride :: Maybe Natural
sourceVersion :: Maybe Text
sourceTypeOverride :: Maybe SourceType
sourceLocationOverride :: Maybe Text
sourceAuthOverride :: Maybe SourceAuth
serviceRoleOverride :: Maybe Text
secondarySourcesVersionOverride :: Maybe [ProjectSourceVersion]
secondarySourcesOverride :: Maybe [ProjectSource]
secondaryArtifactsOverride :: Maybe [ProjectArtifacts]
reportBuildStatusOverride :: Maybe Bool
registryCredentialOverride :: Maybe RegistryCredential
queuedTimeoutInMinutesOverride :: Maybe Natural
privilegedModeOverride :: Maybe Bool
logsConfigOverride :: Maybe LogsConfig
insecureSslOverride :: Maybe Bool
imagePullCredentialsTypeOverride :: Maybe ImagePullCredentialsType
imageOverride :: Maybe Text
idempotencyToken :: Maybe Text
gitSubmodulesConfigOverride :: Maybe GitSubmodulesConfig
gitCloneDepthOverride :: Maybe Natural
environmentVariablesOverride :: Maybe [EnvironmentVariable]
environmentTypeOverride :: Maybe EnvironmentType
encryptionKeyOverride :: Maybe Text
debugSessionEnabled :: Maybe Bool
computeTypeOverride :: Maybe ComputeType
certificateOverride :: Maybe Text
cacheOverride :: Maybe ProjectCache
buildspecOverride :: Maybe Text
buildStatusConfigOverride :: Maybe BuildStatusConfig
artifactsOverride :: Maybe ProjectArtifacts
$sel:projectName:StartBuild' :: StartBuild -> Text
$sel:timeoutInMinutesOverride:StartBuild' :: StartBuild -> Maybe Natural
$sel:sourceVersion:StartBuild' :: StartBuild -> Maybe Text
$sel:sourceTypeOverride:StartBuild' :: StartBuild -> Maybe SourceType
$sel:sourceLocationOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:sourceAuthOverride:StartBuild' :: StartBuild -> Maybe SourceAuth
$sel:serviceRoleOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:secondarySourcesVersionOverride:StartBuild' :: StartBuild -> Maybe [ProjectSourceVersion]
$sel:secondarySourcesOverride:StartBuild' :: StartBuild -> Maybe [ProjectSource]
$sel:secondaryArtifactsOverride:StartBuild' :: StartBuild -> Maybe [ProjectArtifacts]
$sel:reportBuildStatusOverride:StartBuild' :: StartBuild -> Maybe Bool
$sel:registryCredentialOverride:StartBuild' :: StartBuild -> Maybe RegistryCredential
$sel:queuedTimeoutInMinutesOverride:StartBuild' :: StartBuild -> Maybe Natural
$sel:privilegedModeOverride:StartBuild' :: StartBuild -> Maybe Bool
$sel:logsConfigOverride:StartBuild' :: StartBuild -> Maybe LogsConfig
$sel:insecureSslOverride:StartBuild' :: StartBuild -> Maybe Bool
$sel:imagePullCredentialsTypeOverride:StartBuild' :: StartBuild -> Maybe ImagePullCredentialsType
$sel:imageOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:idempotencyToken:StartBuild' :: StartBuild -> Maybe Text
$sel:gitSubmodulesConfigOverride:StartBuild' :: StartBuild -> Maybe GitSubmodulesConfig
$sel:gitCloneDepthOverride:StartBuild' :: StartBuild -> Maybe Natural
$sel:environmentVariablesOverride:StartBuild' :: StartBuild -> Maybe [EnvironmentVariable]
$sel:environmentTypeOverride:StartBuild' :: StartBuild -> Maybe EnvironmentType
$sel:encryptionKeyOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:debugSessionEnabled:StartBuild' :: StartBuild -> Maybe Bool
$sel:computeTypeOverride:StartBuild' :: StartBuild -> Maybe ComputeType
$sel:certificateOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:cacheOverride:StartBuild' :: StartBuild -> Maybe ProjectCache
$sel:buildspecOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:buildStatusConfigOverride:StartBuild' :: StartBuild -> Maybe BuildStatusConfig
$sel:artifactsOverride:StartBuild' :: StartBuild -> Maybe ProjectArtifacts
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProjectArtifacts
artifactsOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BuildStatusConfig
buildStatusConfigOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
buildspecOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProjectCache
cacheOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
certificateOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ComputeType
computeTypeOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
debugSessionEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
encryptionKeyOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EnvironmentType
environmentTypeOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [EnvironmentVariable]
environmentVariablesOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
gitCloneDepthOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GitSubmodulesConfig
gitSubmodulesConfigOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
idempotencyToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
imageOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ImagePullCredentialsType
imagePullCredentialsTypeOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
insecureSslOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LogsConfig
logsConfigOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
privilegedModeOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
queuedTimeoutInMinutesOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RegistryCredential
registryCredentialOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
reportBuildStatusOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ProjectArtifacts]
secondaryArtifactsOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ProjectSource]
secondarySourcesOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ProjectSourceVersion]
secondarySourcesVersionOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceRoleOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SourceAuth
sourceAuthOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceLocationOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SourceType
sourceTypeOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
timeoutInMinutesOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
projectName

instance Prelude.NFData StartBuild where
  rnf :: StartBuild -> ()
rnf StartBuild' {Maybe Bool
Maybe Natural
Maybe [EnvironmentVariable]
Maybe [ProjectArtifacts]
Maybe [ProjectSourceVersion]
Maybe [ProjectSource]
Maybe Text
Maybe BuildStatusConfig
Maybe ComputeType
Maybe EnvironmentType
Maybe GitSubmodulesConfig
Maybe ImagePullCredentialsType
Maybe ProjectArtifacts
Maybe ProjectCache
Maybe RegistryCredential
Maybe LogsConfig
Maybe SourceAuth
Maybe SourceType
Text
projectName :: Text
timeoutInMinutesOverride :: Maybe Natural
sourceVersion :: Maybe Text
sourceTypeOverride :: Maybe SourceType
sourceLocationOverride :: Maybe Text
sourceAuthOverride :: Maybe SourceAuth
serviceRoleOverride :: Maybe Text
secondarySourcesVersionOverride :: Maybe [ProjectSourceVersion]
secondarySourcesOverride :: Maybe [ProjectSource]
secondaryArtifactsOverride :: Maybe [ProjectArtifacts]
reportBuildStatusOverride :: Maybe Bool
registryCredentialOverride :: Maybe RegistryCredential
queuedTimeoutInMinutesOverride :: Maybe Natural
privilegedModeOverride :: Maybe Bool
logsConfigOverride :: Maybe LogsConfig
insecureSslOverride :: Maybe Bool
imagePullCredentialsTypeOverride :: Maybe ImagePullCredentialsType
imageOverride :: Maybe Text
idempotencyToken :: Maybe Text
gitSubmodulesConfigOverride :: Maybe GitSubmodulesConfig
gitCloneDepthOverride :: Maybe Natural
environmentVariablesOverride :: Maybe [EnvironmentVariable]
environmentTypeOverride :: Maybe EnvironmentType
encryptionKeyOverride :: Maybe Text
debugSessionEnabled :: Maybe Bool
computeTypeOverride :: Maybe ComputeType
certificateOverride :: Maybe Text
cacheOverride :: Maybe ProjectCache
buildspecOverride :: Maybe Text
buildStatusConfigOverride :: Maybe BuildStatusConfig
artifactsOverride :: Maybe ProjectArtifacts
$sel:projectName:StartBuild' :: StartBuild -> Text
$sel:timeoutInMinutesOverride:StartBuild' :: StartBuild -> Maybe Natural
$sel:sourceVersion:StartBuild' :: StartBuild -> Maybe Text
$sel:sourceTypeOverride:StartBuild' :: StartBuild -> Maybe SourceType
$sel:sourceLocationOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:sourceAuthOverride:StartBuild' :: StartBuild -> Maybe SourceAuth
$sel:serviceRoleOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:secondarySourcesVersionOverride:StartBuild' :: StartBuild -> Maybe [ProjectSourceVersion]
$sel:secondarySourcesOverride:StartBuild' :: StartBuild -> Maybe [ProjectSource]
$sel:secondaryArtifactsOverride:StartBuild' :: StartBuild -> Maybe [ProjectArtifacts]
$sel:reportBuildStatusOverride:StartBuild' :: StartBuild -> Maybe Bool
$sel:registryCredentialOverride:StartBuild' :: StartBuild -> Maybe RegistryCredential
$sel:queuedTimeoutInMinutesOverride:StartBuild' :: StartBuild -> Maybe Natural
$sel:privilegedModeOverride:StartBuild' :: StartBuild -> Maybe Bool
$sel:logsConfigOverride:StartBuild' :: StartBuild -> Maybe LogsConfig
$sel:insecureSslOverride:StartBuild' :: StartBuild -> Maybe Bool
$sel:imagePullCredentialsTypeOverride:StartBuild' :: StartBuild -> Maybe ImagePullCredentialsType
$sel:imageOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:idempotencyToken:StartBuild' :: StartBuild -> Maybe Text
$sel:gitSubmodulesConfigOverride:StartBuild' :: StartBuild -> Maybe GitSubmodulesConfig
$sel:gitCloneDepthOverride:StartBuild' :: StartBuild -> Maybe Natural
$sel:environmentVariablesOverride:StartBuild' :: StartBuild -> Maybe [EnvironmentVariable]
$sel:environmentTypeOverride:StartBuild' :: StartBuild -> Maybe EnvironmentType
$sel:encryptionKeyOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:debugSessionEnabled:StartBuild' :: StartBuild -> Maybe Bool
$sel:computeTypeOverride:StartBuild' :: StartBuild -> Maybe ComputeType
$sel:certificateOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:cacheOverride:StartBuild' :: StartBuild -> Maybe ProjectCache
$sel:buildspecOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:buildStatusConfigOverride:StartBuild' :: StartBuild -> Maybe BuildStatusConfig
$sel:artifactsOverride:StartBuild' :: StartBuild -> Maybe ProjectArtifacts
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ProjectArtifacts
artifactsOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BuildStatusConfig
buildStatusConfigOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
buildspecOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProjectCache
cacheOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificateOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ComputeType
computeTypeOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
debugSessionEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
encryptionKeyOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EnvironmentType
environmentTypeOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [EnvironmentVariable]
environmentVariablesOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
gitCloneDepthOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GitSubmodulesConfig
gitSubmodulesConfigOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
idempotencyToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
imageOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe ImagePullCredentialsType
imagePullCredentialsTypeOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
insecureSslOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LogsConfig
logsConfigOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
privilegedModeOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
queuedTimeoutInMinutesOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe RegistryCredential
registryCredentialOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Bool
reportBuildStatusOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [ProjectArtifacts]
secondaryArtifactsOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [ProjectSource]
secondarySourcesOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [ProjectSourceVersion]
secondarySourcesVersionOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
serviceRoleOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe SourceAuth
sourceAuthOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
sourceLocationOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe SourceType
sourceTypeOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
sourceVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Natural
timeoutInMinutesOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Text
projectName

instance Data.ToHeaders StartBuild where
  toHeaders :: StartBuild -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"CodeBuild_20161006.StartBuild" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StartBuild where
  toJSON :: StartBuild -> Value
toJSON StartBuild' {Maybe Bool
Maybe Natural
Maybe [EnvironmentVariable]
Maybe [ProjectArtifacts]
Maybe [ProjectSourceVersion]
Maybe [ProjectSource]
Maybe Text
Maybe BuildStatusConfig
Maybe ComputeType
Maybe EnvironmentType
Maybe GitSubmodulesConfig
Maybe ImagePullCredentialsType
Maybe ProjectArtifacts
Maybe ProjectCache
Maybe RegistryCredential
Maybe LogsConfig
Maybe SourceAuth
Maybe SourceType
Text
projectName :: Text
timeoutInMinutesOverride :: Maybe Natural
sourceVersion :: Maybe Text
sourceTypeOverride :: Maybe SourceType
sourceLocationOverride :: Maybe Text
sourceAuthOverride :: Maybe SourceAuth
serviceRoleOverride :: Maybe Text
secondarySourcesVersionOverride :: Maybe [ProjectSourceVersion]
secondarySourcesOverride :: Maybe [ProjectSource]
secondaryArtifactsOverride :: Maybe [ProjectArtifacts]
reportBuildStatusOverride :: Maybe Bool
registryCredentialOverride :: Maybe RegistryCredential
queuedTimeoutInMinutesOverride :: Maybe Natural
privilegedModeOverride :: Maybe Bool
logsConfigOverride :: Maybe LogsConfig
insecureSslOverride :: Maybe Bool
imagePullCredentialsTypeOverride :: Maybe ImagePullCredentialsType
imageOverride :: Maybe Text
idempotencyToken :: Maybe Text
gitSubmodulesConfigOverride :: Maybe GitSubmodulesConfig
gitCloneDepthOverride :: Maybe Natural
environmentVariablesOverride :: Maybe [EnvironmentVariable]
environmentTypeOverride :: Maybe EnvironmentType
encryptionKeyOverride :: Maybe Text
debugSessionEnabled :: Maybe Bool
computeTypeOverride :: Maybe ComputeType
certificateOverride :: Maybe Text
cacheOverride :: Maybe ProjectCache
buildspecOverride :: Maybe Text
buildStatusConfigOverride :: Maybe BuildStatusConfig
artifactsOverride :: Maybe ProjectArtifacts
$sel:projectName:StartBuild' :: StartBuild -> Text
$sel:timeoutInMinutesOverride:StartBuild' :: StartBuild -> Maybe Natural
$sel:sourceVersion:StartBuild' :: StartBuild -> Maybe Text
$sel:sourceTypeOverride:StartBuild' :: StartBuild -> Maybe SourceType
$sel:sourceLocationOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:sourceAuthOverride:StartBuild' :: StartBuild -> Maybe SourceAuth
$sel:serviceRoleOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:secondarySourcesVersionOverride:StartBuild' :: StartBuild -> Maybe [ProjectSourceVersion]
$sel:secondarySourcesOverride:StartBuild' :: StartBuild -> Maybe [ProjectSource]
$sel:secondaryArtifactsOverride:StartBuild' :: StartBuild -> Maybe [ProjectArtifacts]
$sel:reportBuildStatusOverride:StartBuild' :: StartBuild -> Maybe Bool
$sel:registryCredentialOverride:StartBuild' :: StartBuild -> Maybe RegistryCredential
$sel:queuedTimeoutInMinutesOverride:StartBuild' :: StartBuild -> Maybe Natural
$sel:privilegedModeOverride:StartBuild' :: StartBuild -> Maybe Bool
$sel:logsConfigOverride:StartBuild' :: StartBuild -> Maybe LogsConfig
$sel:insecureSslOverride:StartBuild' :: StartBuild -> Maybe Bool
$sel:imagePullCredentialsTypeOverride:StartBuild' :: StartBuild -> Maybe ImagePullCredentialsType
$sel:imageOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:idempotencyToken:StartBuild' :: StartBuild -> Maybe Text
$sel:gitSubmodulesConfigOverride:StartBuild' :: StartBuild -> Maybe GitSubmodulesConfig
$sel:gitCloneDepthOverride:StartBuild' :: StartBuild -> Maybe Natural
$sel:environmentVariablesOverride:StartBuild' :: StartBuild -> Maybe [EnvironmentVariable]
$sel:environmentTypeOverride:StartBuild' :: StartBuild -> Maybe EnvironmentType
$sel:encryptionKeyOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:debugSessionEnabled:StartBuild' :: StartBuild -> Maybe Bool
$sel:computeTypeOverride:StartBuild' :: StartBuild -> Maybe ComputeType
$sel:certificateOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:cacheOverride:StartBuild' :: StartBuild -> Maybe ProjectCache
$sel:buildspecOverride:StartBuild' :: StartBuild -> Maybe Text
$sel:buildStatusConfigOverride:StartBuild' :: StartBuild -> Maybe BuildStatusConfig
$sel:artifactsOverride:StartBuild' :: StartBuild -> Maybe ProjectArtifacts
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"artifactsOverride" 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 ProjectArtifacts
artifactsOverride,
            (Key
"buildStatusConfigOverride" 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 BuildStatusConfig
buildStatusConfigOverride,
            (Key
"buildspecOverride" 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
buildspecOverride,
            (Key
"cacheOverride" 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 ProjectCache
cacheOverride,
            (Key
"certificateOverride" 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
certificateOverride,
            (Key
"computeTypeOverride" 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 ComputeType
computeTypeOverride,
            (Key
"debugSessionEnabled" 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 Bool
debugSessionEnabled,
            (Key
"encryptionKeyOverride" 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
encryptionKeyOverride,
            (Key
"environmentTypeOverride" 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 EnvironmentType
environmentTypeOverride,
            (Key
"environmentVariablesOverride" 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 [EnvironmentVariable]
environmentVariablesOverride,
            (Key
"gitCloneDepthOverride" 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 Natural
gitCloneDepthOverride,
            (Key
"gitSubmodulesConfigOverride" 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 GitSubmodulesConfig
gitSubmodulesConfigOverride,
            (Key
"idempotencyToken" 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
idempotencyToken,
            (Key
"imageOverride" 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
imageOverride,
            (Key
"imagePullCredentialsTypeOverride" 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 ImagePullCredentialsType
imagePullCredentialsTypeOverride,
            (Key
"insecureSslOverride" 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 Bool
insecureSslOverride,
            (Key
"logsConfigOverride" 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 LogsConfig
logsConfigOverride,
            (Key
"privilegedModeOverride" 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 Bool
privilegedModeOverride,
            (Key
"queuedTimeoutInMinutesOverride" 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 Natural
queuedTimeoutInMinutesOverride,
            (Key
"registryCredentialOverride" 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 RegistryCredential
registryCredentialOverride,
            (Key
"reportBuildStatusOverride" 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 Bool
reportBuildStatusOverride,
            (Key
"secondaryArtifactsOverride" 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 [ProjectArtifacts]
secondaryArtifactsOverride,
            (Key
"secondarySourcesOverride" 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 [ProjectSource]
secondarySourcesOverride,
            (Key
"secondarySourcesVersionOverride" 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 [ProjectSourceVersion]
secondarySourcesVersionOverride,
            (Key
"serviceRoleOverride" 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
serviceRoleOverride,
            (Key
"sourceAuthOverride" 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 SourceAuth
sourceAuthOverride,
            (Key
"sourceLocationOverride" 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
sourceLocationOverride,
            (Key
"sourceTypeOverride" 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 SourceType
sourceTypeOverride,
            (Key
"sourceVersion" 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
sourceVersion,
            (Key
"timeoutInMinutesOverride" 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 Natural
timeoutInMinutesOverride,
            forall a. a -> Maybe a
Prelude.Just (Key
"projectName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
projectName)
          ]
      )

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

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

-- | /See:/ 'newStartBuildResponse' smart constructor.
data StartBuildResponse = StartBuildResponse'
  { -- | Information about the build to be run.
    StartBuildResponse -> Maybe Build
build :: Prelude.Maybe Build,
    -- | The response's http status code.
    StartBuildResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartBuildResponse -> StartBuildResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartBuildResponse -> StartBuildResponse -> Bool
$c/= :: StartBuildResponse -> StartBuildResponse -> Bool
== :: StartBuildResponse -> StartBuildResponse -> Bool
$c== :: StartBuildResponse -> StartBuildResponse -> Bool
Prelude.Eq, ReadPrec [StartBuildResponse]
ReadPrec StartBuildResponse
Int -> ReadS StartBuildResponse
ReadS [StartBuildResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartBuildResponse]
$creadListPrec :: ReadPrec [StartBuildResponse]
readPrec :: ReadPrec StartBuildResponse
$creadPrec :: ReadPrec StartBuildResponse
readList :: ReadS [StartBuildResponse]
$creadList :: ReadS [StartBuildResponse]
readsPrec :: Int -> ReadS StartBuildResponse
$creadsPrec :: Int -> ReadS StartBuildResponse
Prelude.Read, Int -> StartBuildResponse -> ShowS
[StartBuildResponse] -> ShowS
StartBuildResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartBuildResponse] -> ShowS
$cshowList :: [StartBuildResponse] -> ShowS
show :: StartBuildResponse -> String
$cshow :: StartBuildResponse -> String
showsPrec :: Int -> StartBuildResponse -> ShowS
$cshowsPrec :: Int -> StartBuildResponse -> ShowS
Prelude.Show, forall x. Rep StartBuildResponse x -> StartBuildResponse
forall x. StartBuildResponse -> Rep StartBuildResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartBuildResponse x -> StartBuildResponse
$cfrom :: forall x. StartBuildResponse -> Rep StartBuildResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartBuildResponse' 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:
--
-- 'build', 'startBuildResponse_build' - Information about the build to be run.
--
-- 'httpStatus', 'startBuildResponse_httpStatus' - The response's http status code.
newStartBuildResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartBuildResponse
newStartBuildResponse :: Int -> StartBuildResponse
newStartBuildResponse Int
pHttpStatus_ =
  StartBuildResponse'
    { $sel:build:StartBuildResponse' :: Maybe Build
build = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartBuildResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the build to be run.
startBuildResponse_build :: Lens.Lens' StartBuildResponse (Prelude.Maybe Build)
startBuildResponse_build :: Lens' StartBuildResponse (Maybe Build)
startBuildResponse_build = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBuildResponse' {Maybe Build
build :: Maybe Build
$sel:build:StartBuildResponse' :: StartBuildResponse -> Maybe Build
build} -> Maybe Build
build) (\s :: StartBuildResponse
s@StartBuildResponse' {} Maybe Build
a -> StartBuildResponse
s {$sel:build:StartBuildResponse' :: Maybe Build
build = Maybe Build
a} :: StartBuildResponse)

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

instance Prelude.NFData StartBuildResponse where
  rnf :: StartBuildResponse -> ()
rnf StartBuildResponse' {Int
Maybe Build
httpStatus :: Int
build :: Maybe Build
$sel:httpStatus:StartBuildResponse' :: StartBuildResponse -> Int
$sel:build:StartBuildResponse' :: StartBuildResponse -> Maybe Build
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Build
build
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus