{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Proton.Types.Environment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Proton.Types.Environment 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 Amazonka.Proton.Types.DeploymentStatus
import Amazonka.Proton.Types.Provisioning
import Amazonka.Proton.Types.RepositoryBranch

-- | Detailed data of an Proton environment resource. An Proton environment
-- is a set of resources shared across Proton services.
--
-- /See:/ 'newEnvironment' smart constructor.
data Environment = Environment'
  { -- | The Amazon Resource Name (ARN) of the IAM service role that allows
    -- Proton to provision infrastructure using CodeBuild-based provisioning on
    -- your behalf.
    Environment -> Maybe Text
codebuildRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the IAM service role that Proton uses
    -- when provisioning directly defined components in this environment. It
    -- determines the scope of infrastructure that a component can provision.
    --
    -- The environment must have a @componentRoleArn@ to allow directly defined
    -- components to be associated with the environment.
    --
    -- For more information about components, see
    -- <https://docs.aws.amazon.com/proton/latest/userguide/ag-components.html Proton components>
    -- in the /Proton User Guide/.
    Environment -> Maybe Text
componentRoleArn :: Prelude.Maybe Prelude.Text,
    -- | An environment deployment status message.
    Environment -> Maybe (Sensitive Text)
deploymentStatusMessage :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The description of the environment.
    Environment -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The ID of the environment account connection that\'s used to provision
    -- infrastructure resources in an environment account.
    Environment -> Maybe Text
environmentAccountConnectionId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the environment account that the environment infrastructure
    -- resources are provisioned in.
    Environment -> Maybe Text
environmentAccountId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Proton service role that allows
    -- Proton to make calls to other services on your behalf.
    Environment -> Maybe Text
protonServiceRoleArn :: Prelude.Maybe Prelude.Text,
    -- | When included, indicates that the environment template is for customer
    -- provisioned and managed infrastructure.
    Environment -> Maybe Provisioning
provisioning :: Prelude.Maybe Provisioning,
    -- | The linked repository that you use to host your rendered infrastructure
    -- templates for self-managed provisioning. A linked repository is a
    -- repository that has been registered with Proton. For more information,
    -- see CreateRepository.
    Environment -> Maybe RepositoryBranch
provisioningRepository :: Prelude.Maybe RepositoryBranch,
    -- | The environment spec.
    Environment -> Maybe (Sensitive Text)
spec :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The Amazon Resource Name (ARN) of the environment.
    Environment -> Text
arn :: Prelude.Text,
    -- | The time when the environment was created.
    Environment -> POSIX
createdAt :: Data.POSIX,
    -- | The environment deployment status.
    Environment -> DeploymentStatus
deploymentStatus :: DeploymentStatus,
    -- | The time when a deployment of the environment was last attempted.
    Environment -> POSIX
lastDeploymentAttemptedAt :: Data.POSIX,
    -- | The time when the environment was last deployed successfully.
    Environment -> POSIX
lastDeploymentSucceededAt :: Data.POSIX,
    -- | The name of the environment.
    Environment -> Text
name :: Prelude.Text,
    -- | The major version of the environment template.
    Environment -> Text
templateMajorVersion :: Prelude.Text,
    -- | The minor version of the environment template.
    Environment -> Text
templateMinorVersion :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the environment template.
    Environment -> Text
templateName :: Prelude.Text
  }
  deriving (Environment -> Environment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Environment -> Environment -> Bool
$c/= :: Environment -> Environment -> Bool
== :: Environment -> Environment -> Bool
$c== :: Environment -> Environment -> Bool
Prelude.Eq, Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Environment] -> ShowS
$cshowList :: [Environment] -> ShowS
show :: Environment -> String
$cshow :: Environment -> String
showsPrec :: Int -> Environment -> ShowS
$cshowsPrec :: Int -> Environment -> ShowS
Prelude.Show, forall x. Rep Environment x -> Environment
forall x. Environment -> Rep Environment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Environment x -> Environment
$cfrom :: forall x. Environment -> Rep Environment x
Prelude.Generic)

-- |
-- Create a value of 'Environment' 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:
--
-- 'codebuildRoleArn', 'environment_codebuildRoleArn' - The Amazon Resource Name (ARN) of the IAM service role that allows
-- Proton to provision infrastructure using CodeBuild-based provisioning on
-- your behalf.
--
-- 'componentRoleArn', 'environment_componentRoleArn' - The Amazon Resource Name (ARN) of the IAM service role that Proton uses
-- when provisioning directly defined components in this environment. It
-- determines the scope of infrastructure that a component can provision.
--
-- The environment must have a @componentRoleArn@ to allow directly defined
-- components to be associated with the environment.
--
-- For more information about components, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/ag-components.html Proton components>
-- in the /Proton User Guide/.
--
-- 'deploymentStatusMessage', 'environment_deploymentStatusMessage' - An environment deployment status message.
--
-- 'description', 'environment_description' - The description of the environment.
--
-- 'environmentAccountConnectionId', 'environment_environmentAccountConnectionId' - The ID of the environment account connection that\'s used to provision
-- infrastructure resources in an environment account.
--
-- 'environmentAccountId', 'environment_environmentAccountId' - The ID of the environment account that the environment infrastructure
-- resources are provisioned in.
--
-- 'protonServiceRoleArn', 'environment_protonServiceRoleArn' - The Amazon Resource Name (ARN) of the Proton service role that allows
-- Proton to make calls to other services on your behalf.
--
-- 'provisioning', 'environment_provisioning' - When included, indicates that the environment template is for customer
-- provisioned and managed infrastructure.
--
-- 'provisioningRepository', 'environment_provisioningRepository' - The linked repository that you use to host your rendered infrastructure
-- templates for self-managed provisioning. A linked repository is a
-- repository that has been registered with Proton. For more information,
-- see CreateRepository.
--
-- 'spec', 'environment_spec' - The environment spec.
--
-- 'arn', 'environment_arn' - The Amazon Resource Name (ARN) of the environment.
--
-- 'createdAt', 'environment_createdAt' - The time when the environment was created.
--
-- 'deploymentStatus', 'environment_deploymentStatus' - The environment deployment status.
--
-- 'lastDeploymentAttemptedAt', 'environment_lastDeploymentAttemptedAt' - The time when a deployment of the environment was last attempted.
--
-- 'lastDeploymentSucceededAt', 'environment_lastDeploymentSucceededAt' - The time when the environment was last deployed successfully.
--
-- 'name', 'environment_name' - The name of the environment.
--
-- 'templateMajorVersion', 'environment_templateMajorVersion' - The major version of the environment template.
--
-- 'templateMinorVersion', 'environment_templateMinorVersion' - The minor version of the environment template.
--
-- 'templateName', 'environment_templateName' - The Amazon Resource Name (ARN) of the environment template.
newEnvironment ::
  -- | 'arn'
  Prelude.Text ->
  -- | 'createdAt'
  Prelude.UTCTime ->
  -- | 'deploymentStatus'
  DeploymentStatus ->
  -- | 'lastDeploymentAttemptedAt'
  Prelude.UTCTime ->
  -- | 'lastDeploymentSucceededAt'
  Prelude.UTCTime ->
  -- | 'name'
  Prelude.Text ->
  -- | 'templateMajorVersion'
  Prelude.Text ->
  -- | 'templateMinorVersion'
  Prelude.Text ->
  -- | 'templateName'
  Prelude.Text ->
  Environment
newEnvironment :: Text
-> UTCTime
-> DeploymentStatus
-> UTCTime
-> UTCTime
-> Text
-> Text
-> Text
-> Text
-> Environment
newEnvironment
  Text
pArn_
  UTCTime
pCreatedAt_
  DeploymentStatus
pDeploymentStatus_
  UTCTime
pLastDeploymentAttemptedAt_
  UTCTime
pLastDeploymentSucceededAt_
  Text
pName_
  Text
pTemplateMajorVersion_
  Text
pTemplateMinorVersion_
  Text
pTemplateName_ =
    Environment'
      { $sel:codebuildRoleArn:Environment' :: Maybe Text
codebuildRoleArn = forall a. Maybe a
Prelude.Nothing,
        $sel:componentRoleArn:Environment' :: Maybe Text
componentRoleArn = forall a. Maybe a
Prelude.Nothing,
        $sel:deploymentStatusMessage:Environment' :: Maybe (Sensitive Text)
deploymentStatusMessage = forall a. Maybe a
Prelude.Nothing,
        $sel:description:Environment' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
        $sel:environmentAccountConnectionId:Environment' :: Maybe Text
environmentAccountConnectionId = forall a. Maybe a
Prelude.Nothing,
        $sel:environmentAccountId:Environment' :: Maybe Text
environmentAccountId = forall a. Maybe a
Prelude.Nothing,
        $sel:protonServiceRoleArn:Environment' :: Maybe Text
protonServiceRoleArn = forall a. Maybe a
Prelude.Nothing,
        $sel:provisioning:Environment' :: Maybe Provisioning
provisioning = forall a. Maybe a
Prelude.Nothing,
        $sel:provisioningRepository:Environment' :: Maybe RepositoryBranch
provisioningRepository = forall a. Maybe a
Prelude.Nothing,
        $sel:spec:Environment' :: Maybe (Sensitive Text)
spec = forall a. Maybe a
Prelude.Nothing,
        $sel:arn:Environment' :: Text
arn = Text
pArn_,
        $sel:createdAt:Environment' :: POSIX
createdAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedAt_,
        $sel:deploymentStatus:Environment' :: DeploymentStatus
deploymentStatus = DeploymentStatus
pDeploymentStatus_,
        $sel:lastDeploymentAttemptedAt:Environment' :: POSIX
lastDeploymentAttemptedAt =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastDeploymentAttemptedAt_,
        $sel:lastDeploymentSucceededAt:Environment' :: POSIX
lastDeploymentSucceededAt =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastDeploymentSucceededAt_,
        $sel:name:Environment' :: Text
name = Text
pName_,
        $sel:templateMajorVersion:Environment' :: Text
templateMajorVersion = Text
pTemplateMajorVersion_,
        $sel:templateMinorVersion:Environment' :: Text
templateMinorVersion = Text
pTemplateMinorVersion_,
        $sel:templateName:Environment' :: Text
templateName = Text
pTemplateName_
      }

-- | The Amazon Resource Name (ARN) of the IAM service role that allows
-- Proton to provision infrastructure using CodeBuild-based provisioning on
-- your behalf.
environment_codebuildRoleArn :: Lens.Lens' Environment (Prelude.Maybe Prelude.Text)
environment_codebuildRoleArn :: Lens' Environment (Maybe Text)
environment_codebuildRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe Text
codebuildRoleArn :: Maybe Text
$sel:codebuildRoleArn:Environment' :: Environment -> Maybe Text
codebuildRoleArn} -> Maybe Text
codebuildRoleArn) (\s :: Environment
s@Environment' {} Maybe Text
a -> Environment
s {$sel:codebuildRoleArn:Environment' :: Maybe Text
codebuildRoleArn = Maybe Text
a} :: Environment)

-- | The Amazon Resource Name (ARN) of the IAM service role that Proton uses
-- when provisioning directly defined components in this environment. It
-- determines the scope of infrastructure that a component can provision.
--
-- The environment must have a @componentRoleArn@ to allow directly defined
-- components to be associated with the environment.
--
-- For more information about components, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/ag-components.html Proton components>
-- in the /Proton User Guide/.
environment_componentRoleArn :: Lens.Lens' Environment (Prelude.Maybe Prelude.Text)
environment_componentRoleArn :: Lens' Environment (Maybe Text)
environment_componentRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe Text
componentRoleArn :: Maybe Text
$sel:componentRoleArn:Environment' :: Environment -> Maybe Text
componentRoleArn} -> Maybe Text
componentRoleArn) (\s :: Environment
s@Environment' {} Maybe Text
a -> Environment
s {$sel:componentRoleArn:Environment' :: Maybe Text
componentRoleArn = Maybe Text
a} :: Environment)

-- | An environment deployment status message.
environment_deploymentStatusMessage :: Lens.Lens' Environment (Prelude.Maybe Prelude.Text)
environment_deploymentStatusMessage :: Lens' Environment (Maybe Text)
environment_deploymentStatusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe (Sensitive Text)
deploymentStatusMessage :: Maybe (Sensitive Text)
$sel:deploymentStatusMessage:Environment' :: Environment -> Maybe (Sensitive Text)
deploymentStatusMessage} -> Maybe (Sensitive Text)
deploymentStatusMessage) (\s :: Environment
s@Environment' {} Maybe (Sensitive Text)
a -> Environment
s {$sel:deploymentStatusMessage:Environment' :: Maybe (Sensitive Text)
deploymentStatusMessage = Maybe (Sensitive Text)
a} :: Environment) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The description of the environment.
environment_description :: Lens.Lens' Environment (Prelude.Maybe Prelude.Text)
environment_description :: Lens' Environment (Maybe Text)
environment_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:Environment' :: Environment -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: Environment
s@Environment' {} Maybe (Sensitive Text)
a -> Environment
s {$sel:description:Environment' :: Maybe (Sensitive Text)
description = Maybe (Sensitive Text)
a} :: Environment) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The ID of the environment account connection that\'s used to provision
-- infrastructure resources in an environment account.
environment_environmentAccountConnectionId :: Lens.Lens' Environment (Prelude.Maybe Prelude.Text)
environment_environmentAccountConnectionId :: Lens' Environment (Maybe Text)
environment_environmentAccountConnectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe Text
environmentAccountConnectionId :: Maybe Text
$sel:environmentAccountConnectionId:Environment' :: Environment -> Maybe Text
environmentAccountConnectionId} -> Maybe Text
environmentAccountConnectionId) (\s :: Environment
s@Environment' {} Maybe Text
a -> Environment
s {$sel:environmentAccountConnectionId:Environment' :: Maybe Text
environmentAccountConnectionId = Maybe Text
a} :: Environment)

-- | The ID of the environment account that the environment infrastructure
-- resources are provisioned in.
environment_environmentAccountId :: Lens.Lens' Environment (Prelude.Maybe Prelude.Text)
environment_environmentAccountId :: Lens' Environment (Maybe Text)
environment_environmentAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe Text
environmentAccountId :: Maybe Text
$sel:environmentAccountId:Environment' :: Environment -> Maybe Text
environmentAccountId} -> Maybe Text
environmentAccountId) (\s :: Environment
s@Environment' {} Maybe Text
a -> Environment
s {$sel:environmentAccountId:Environment' :: Maybe Text
environmentAccountId = Maybe Text
a} :: Environment)

-- | The Amazon Resource Name (ARN) of the Proton service role that allows
-- Proton to make calls to other services on your behalf.
environment_protonServiceRoleArn :: Lens.Lens' Environment (Prelude.Maybe Prelude.Text)
environment_protonServiceRoleArn :: Lens' Environment (Maybe Text)
environment_protonServiceRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe Text
protonServiceRoleArn :: Maybe Text
$sel:protonServiceRoleArn:Environment' :: Environment -> Maybe Text
protonServiceRoleArn} -> Maybe Text
protonServiceRoleArn) (\s :: Environment
s@Environment' {} Maybe Text
a -> Environment
s {$sel:protonServiceRoleArn:Environment' :: Maybe Text
protonServiceRoleArn = Maybe Text
a} :: Environment)

-- | When included, indicates that the environment template is for customer
-- provisioned and managed infrastructure.
environment_provisioning :: Lens.Lens' Environment (Prelude.Maybe Provisioning)
environment_provisioning :: Lens' Environment (Maybe Provisioning)
environment_provisioning = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe Provisioning
provisioning :: Maybe Provisioning
$sel:provisioning:Environment' :: Environment -> Maybe Provisioning
provisioning} -> Maybe Provisioning
provisioning) (\s :: Environment
s@Environment' {} Maybe Provisioning
a -> Environment
s {$sel:provisioning:Environment' :: Maybe Provisioning
provisioning = Maybe Provisioning
a} :: Environment)

-- | The linked repository that you use to host your rendered infrastructure
-- templates for self-managed provisioning. A linked repository is a
-- repository that has been registered with Proton. For more information,
-- see CreateRepository.
environment_provisioningRepository :: Lens.Lens' Environment (Prelude.Maybe RepositoryBranch)
environment_provisioningRepository :: Lens' Environment (Maybe RepositoryBranch)
environment_provisioningRepository = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe RepositoryBranch
provisioningRepository :: Maybe RepositoryBranch
$sel:provisioningRepository:Environment' :: Environment -> Maybe RepositoryBranch
provisioningRepository} -> Maybe RepositoryBranch
provisioningRepository) (\s :: Environment
s@Environment' {} Maybe RepositoryBranch
a -> Environment
s {$sel:provisioningRepository:Environment' :: Maybe RepositoryBranch
provisioningRepository = Maybe RepositoryBranch
a} :: Environment)

-- | The environment spec.
environment_spec :: Lens.Lens' Environment (Prelude.Maybe Prelude.Text)
environment_spec :: Lens' Environment (Maybe Text)
environment_spec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe (Sensitive Text)
spec :: Maybe (Sensitive Text)
$sel:spec:Environment' :: Environment -> Maybe (Sensitive Text)
spec} -> Maybe (Sensitive Text)
spec) (\s :: Environment
s@Environment' {} Maybe (Sensitive Text)
a -> Environment
s {$sel:spec:Environment' :: Maybe (Sensitive Text)
spec = Maybe (Sensitive Text)
a} :: Environment) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The Amazon Resource Name (ARN) of the environment.
environment_arn :: Lens.Lens' Environment Prelude.Text
environment_arn :: Lens' Environment Text
environment_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Text
arn :: Text
$sel:arn:Environment' :: Environment -> Text
arn} -> Text
arn) (\s :: Environment
s@Environment' {} Text
a -> Environment
s {$sel:arn:Environment' :: Text
arn = Text
a} :: Environment)

-- | The time when the environment was created.
environment_createdAt :: Lens.Lens' Environment Prelude.UTCTime
environment_createdAt :: Lens' Environment UTCTime
environment_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {POSIX
createdAt :: POSIX
$sel:createdAt:Environment' :: Environment -> POSIX
createdAt} -> POSIX
createdAt) (\s :: Environment
s@Environment' {} POSIX
a -> Environment
s {$sel:createdAt:Environment' :: POSIX
createdAt = POSIX
a} :: Environment) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The environment deployment status.
environment_deploymentStatus :: Lens.Lens' Environment DeploymentStatus
environment_deploymentStatus :: Lens' Environment DeploymentStatus
environment_deploymentStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {DeploymentStatus
deploymentStatus :: DeploymentStatus
$sel:deploymentStatus:Environment' :: Environment -> DeploymentStatus
deploymentStatus} -> DeploymentStatus
deploymentStatus) (\s :: Environment
s@Environment' {} DeploymentStatus
a -> Environment
s {$sel:deploymentStatus:Environment' :: DeploymentStatus
deploymentStatus = DeploymentStatus
a} :: Environment)

-- | The time when a deployment of the environment was last attempted.
environment_lastDeploymentAttemptedAt :: Lens.Lens' Environment Prelude.UTCTime
environment_lastDeploymentAttemptedAt :: Lens' Environment UTCTime
environment_lastDeploymentAttemptedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {POSIX
lastDeploymentAttemptedAt :: POSIX
$sel:lastDeploymentAttemptedAt:Environment' :: Environment -> POSIX
lastDeploymentAttemptedAt} -> POSIX
lastDeploymentAttemptedAt) (\s :: Environment
s@Environment' {} POSIX
a -> Environment
s {$sel:lastDeploymentAttemptedAt:Environment' :: POSIX
lastDeploymentAttemptedAt = POSIX
a} :: Environment) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The time when the environment was last deployed successfully.
environment_lastDeploymentSucceededAt :: Lens.Lens' Environment Prelude.UTCTime
environment_lastDeploymentSucceededAt :: Lens' Environment UTCTime
environment_lastDeploymentSucceededAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {POSIX
lastDeploymentSucceededAt :: POSIX
$sel:lastDeploymentSucceededAt:Environment' :: Environment -> POSIX
lastDeploymentSucceededAt} -> POSIX
lastDeploymentSucceededAt) (\s :: Environment
s@Environment' {} POSIX
a -> Environment
s {$sel:lastDeploymentSucceededAt:Environment' :: POSIX
lastDeploymentSucceededAt = POSIX
a} :: Environment) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

-- | The major version of the environment template.
environment_templateMajorVersion :: Lens.Lens' Environment Prelude.Text
environment_templateMajorVersion :: Lens' Environment Text
environment_templateMajorVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Text
templateMajorVersion :: Text
$sel:templateMajorVersion:Environment' :: Environment -> Text
templateMajorVersion} -> Text
templateMajorVersion) (\s :: Environment
s@Environment' {} Text
a -> Environment
s {$sel:templateMajorVersion:Environment' :: Text
templateMajorVersion = Text
a} :: Environment)

-- | The minor version of the environment template.
environment_templateMinorVersion :: Lens.Lens' Environment Prelude.Text
environment_templateMinorVersion :: Lens' Environment Text
environment_templateMinorVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Text
templateMinorVersion :: Text
$sel:templateMinorVersion:Environment' :: Environment -> Text
templateMinorVersion} -> Text
templateMinorVersion) (\s :: Environment
s@Environment' {} Text
a -> Environment
s {$sel:templateMinorVersion:Environment' :: Text
templateMinorVersion = Text
a} :: Environment)

-- | The Amazon Resource Name (ARN) of the environment template.
environment_templateName :: Lens.Lens' Environment Prelude.Text
environment_templateName :: Lens' Environment Text
environment_templateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Text
templateName :: Text
$sel:templateName:Environment' :: Environment -> Text
templateName} -> Text
templateName) (\s :: Environment
s@Environment' {} Text
a -> Environment
s {$sel:templateName:Environment' :: Text
templateName = Text
a} :: Environment)

instance Data.FromJSON Environment where
  parseJSON :: Value -> Parser Environment
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Environment"
      ( \Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe (Sensitive Text)
-> Maybe (Sensitive Text)
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Provisioning
-> Maybe RepositoryBranch
-> Maybe (Sensitive Text)
-> Text
-> POSIX
-> DeploymentStatus
-> POSIX
-> POSIX
-> Text
-> Text
-> Text
-> Text
-> Environment
Environment'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"codebuildRoleArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"componentRoleArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"deploymentStatusMessage")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"environmentAccountConnectionId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"environmentAccountId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"protonServiceRoleArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"provisioning")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"provisioningRepository")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"spec")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"createdAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"deploymentStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"lastDeploymentAttemptedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"lastDeploymentSucceededAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"templateMajorVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"templateMinorVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"templateName")
      )

instance Prelude.Hashable Environment where
  hashWithSalt :: Int -> Environment -> Int
hashWithSalt Int
_salt Environment' {Maybe Text
Maybe (Sensitive Text)
Maybe Provisioning
Maybe RepositoryBranch
Text
POSIX
DeploymentStatus
templateName :: Text
templateMinorVersion :: Text
templateMajorVersion :: Text
name :: Text
lastDeploymentSucceededAt :: POSIX
lastDeploymentAttemptedAt :: POSIX
deploymentStatus :: DeploymentStatus
createdAt :: POSIX
arn :: Text
spec :: Maybe (Sensitive Text)
provisioningRepository :: Maybe RepositoryBranch
provisioning :: Maybe Provisioning
protonServiceRoleArn :: Maybe Text
environmentAccountId :: Maybe Text
environmentAccountConnectionId :: Maybe Text
description :: Maybe (Sensitive Text)
deploymentStatusMessage :: Maybe (Sensitive Text)
componentRoleArn :: Maybe Text
codebuildRoleArn :: Maybe Text
$sel:templateName:Environment' :: Environment -> Text
$sel:templateMinorVersion:Environment' :: Environment -> Text
$sel:templateMajorVersion:Environment' :: Environment -> Text
$sel:name:Environment' :: Environment -> Text
$sel:lastDeploymentSucceededAt:Environment' :: Environment -> POSIX
$sel:lastDeploymentAttemptedAt:Environment' :: Environment -> POSIX
$sel:deploymentStatus:Environment' :: Environment -> DeploymentStatus
$sel:createdAt:Environment' :: Environment -> POSIX
$sel:arn:Environment' :: Environment -> Text
$sel:spec:Environment' :: Environment -> Maybe (Sensitive Text)
$sel:provisioningRepository:Environment' :: Environment -> Maybe RepositoryBranch
$sel:provisioning:Environment' :: Environment -> Maybe Provisioning
$sel:protonServiceRoleArn:Environment' :: Environment -> Maybe Text
$sel:environmentAccountId:Environment' :: Environment -> Maybe Text
$sel:environmentAccountConnectionId:Environment' :: Environment -> Maybe Text
$sel:description:Environment' :: Environment -> Maybe (Sensitive Text)
$sel:deploymentStatusMessage:Environment' :: Environment -> Maybe (Sensitive Text)
$sel:componentRoleArn:Environment' :: Environment -> Maybe Text
$sel:codebuildRoleArn:Environment' :: Environment -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
codebuildRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
componentRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
deploymentStatusMessage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
environmentAccountConnectionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
environmentAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
protonServiceRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Provisioning
provisioning
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RepositoryBranch
provisioningRepository
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
spec
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DeploymentStatus
deploymentStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
lastDeploymentAttemptedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
lastDeploymentSucceededAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
templateMajorVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
templateMinorVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
templateName

instance Prelude.NFData Environment where
  rnf :: Environment -> ()
rnf Environment' {Maybe Text
Maybe (Sensitive Text)
Maybe Provisioning
Maybe RepositoryBranch
Text
POSIX
DeploymentStatus
templateName :: Text
templateMinorVersion :: Text
templateMajorVersion :: Text
name :: Text
lastDeploymentSucceededAt :: POSIX
lastDeploymentAttemptedAt :: POSIX
deploymentStatus :: DeploymentStatus
createdAt :: POSIX
arn :: Text
spec :: Maybe (Sensitive Text)
provisioningRepository :: Maybe RepositoryBranch
provisioning :: Maybe Provisioning
protonServiceRoleArn :: Maybe Text
environmentAccountId :: Maybe Text
environmentAccountConnectionId :: Maybe Text
description :: Maybe (Sensitive Text)
deploymentStatusMessage :: Maybe (Sensitive Text)
componentRoleArn :: Maybe Text
codebuildRoleArn :: Maybe Text
$sel:templateName:Environment' :: Environment -> Text
$sel:templateMinorVersion:Environment' :: Environment -> Text
$sel:templateMajorVersion:Environment' :: Environment -> Text
$sel:name:Environment' :: Environment -> Text
$sel:lastDeploymentSucceededAt:Environment' :: Environment -> POSIX
$sel:lastDeploymentAttemptedAt:Environment' :: Environment -> POSIX
$sel:deploymentStatus:Environment' :: Environment -> DeploymentStatus
$sel:createdAt:Environment' :: Environment -> POSIX
$sel:arn:Environment' :: Environment -> Text
$sel:spec:Environment' :: Environment -> Maybe (Sensitive Text)
$sel:provisioningRepository:Environment' :: Environment -> Maybe RepositoryBranch
$sel:provisioning:Environment' :: Environment -> Maybe Provisioning
$sel:protonServiceRoleArn:Environment' :: Environment -> Maybe Text
$sel:environmentAccountId:Environment' :: Environment -> Maybe Text
$sel:environmentAccountConnectionId:Environment' :: Environment -> Maybe Text
$sel:description:Environment' :: Environment -> Maybe (Sensitive Text)
$sel:deploymentStatusMessage:Environment' :: Environment -> Maybe (Sensitive Text)
$sel:componentRoleArn:Environment' :: Environment -> Maybe Text
$sel:codebuildRoleArn:Environment' :: Environment -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
codebuildRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
componentRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
deploymentStatusMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
environmentAccountConnectionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
environmentAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
protonServiceRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Provisioning
provisioning
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RepositoryBranch
provisioningRepository
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
spec
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DeploymentStatus
deploymentStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
lastDeploymentAttemptedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
lastDeploymentSucceededAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
templateMajorVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
templateMinorVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
templateName