{-# 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.Cloud9.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.Cloud9.Types.Environment where

import Amazonka.Cloud9.Types.ConnectionType
import Amazonka.Cloud9.Types.EnvironmentLifecycle
import Amazonka.Cloud9.Types.EnvironmentType
import Amazonka.Cloud9.Types.ManagedCredentialsStatus
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

-- | Information about an Cloud9 development environment.
--
-- /See:/ 'newEnvironment' smart constructor.
data Environment = Environment'
  { -- | The connection type used for connecting to an Amazon EC2 environment.
    -- @CONNECT_SSH@ is selected by default.
    Environment -> Maybe ConnectionType
connectionType :: Prelude.Maybe ConnectionType,
    -- | The description for the environment.
    Environment -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The ID of the environment.
    Environment -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The state of the environment in its creation or deletion lifecycle.
    Environment -> Maybe EnvironmentLifecycle
lifecycle :: Prelude.Maybe EnvironmentLifecycle,
    -- | Describes the status of Amazon Web Services managed temporary
    -- credentials for the Cloud9 environment. Available values are:
    --
    -- -   @ENABLED_ON_CREATE@
    --
    -- -   @ENABLED_BY_OWNER@
    --
    -- -   @DISABLED_BY_DEFAULT@
    --
    -- -   @DISABLED_BY_OWNER@
    --
    -- -   @DISABLED_BY_COLLABORATOR@
    --
    -- -   @PENDING_REMOVAL_BY_COLLABORATOR@
    --
    -- -   @PENDING_REMOVAL_BY_OWNER@
    --
    -- -   @FAILED_REMOVAL_BY_COLLABORATOR@
    --
    -- -   @ENABLED_BY_OWNER@
    --
    -- -   @DISABLED_BY_DEFAULT@
    Environment -> Maybe ManagedCredentialsStatus
managedCredentialsStatus :: Prelude.Maybe ManagedCredentialsStatus,
    -- | The name of the environment.
    Environment -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The type of environment. Valid values include the following:
    --
    -- -   @ec2@: An Amazon Elastic Compute Cloud (Amazon EC2) instance
    --     connects to the environment.
    --
    -- -   @ssh@: Your own server connects to the environment.
    Environment -> EnvironmentType
type' :: EnvironmentType,
    -- | The Amazon Resource Name (ARN) of the environment.
    Environment -> Text
arn :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the environment owner.
    Environment -> Text
ownerArn :: 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:
--
-- 'connectionType', 'environment_connectionType' - The connection type used for connecting to an Amazon EC2 environment.
-- @CONNECT_SSH@ is selected by default.
--
-- 'description', 'environment_description' - The description for the environment.
--
-- 'id', 'environment_id' - The ID of the environment.
--
-- 'lifecycle', 'environment_lifecycle' - The state of the environment in its creation or deletion lifecycle.
--
-- 'managedCredentialsStatus', 'environment_managedCredentialsStatus' - Describes the status of Amazon Web Services managed temporary
-- credentials for the Cloud9 environment. Available values are:
--
-- -   @ENABLED_ON_CREATE@
--
-- -   @ENABLED_BY_OWNER@
--
-- -   @DISABLED_BY_DEFAULT@
--
-- -   @DISABLED_BY_OWNER@
--
-- -   @DISABLED_BY_COLLABORATOR@
--
-- -   @PENDING_REMOVAL_BY_COLLABORATOR@
--
-- -   @PENDING_REMOVAL_BY_OWNER@
--
-- -   @FAILED_REMOVAL_BY_COLLABORATOR@
--
-- -   @ENABLED_BY_OWNER@
--
-- -   @DISABLED_BY_DEFAULT@
--
-- 'name', 'environment_name' - The name of the environment.
--
-- 'type'', 'environment_type' - The type of environment. Valid values include the following:
--
-- -   @ec2@: An Amazon Elastic Compute Cloud (Amazon EC2) instance
--     connects to the environment.
--
-- -   @ssh@: Your own server connects to the environment.
--
-- 'arn', 'environment_arn' - The Amazon Resource Name (ARN) of the environment.
--
-- 'ownerArn', 'environment_ownerArn' - The Amazon Resource Name (ARN) of the environment owner.
newEnvironment ::
  -- | 'type''
  EnvironmentType ->
  -- | 'arn'
  Prelude.Text ->
  -- | 'ownerArn'
  Prelude.Text ->
  Environment
newEnvironment :: EnvironmentType -> Text -> Text -> Environment
newEnvironment EnvironmentType
pType_ Text
pArn_ Text
pOwnerArn_ =
  Environment'
    { $sel:connectionType:Environment' :: Maybe ConnectionType
connectionType = forall a. Maybe a
Prelude.Nothing,
      $sel:description:Environment' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Environment' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:lifecycle:Environment' :: Maybe EnvironmentLifecycle
lifecycle = forall a. Maybe a
Prelude.Nothing,
      $sel:managedCredentialsStatus:Environment' :: Maybe ManagedCredentialsStatus
managedCredentialsStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Environment' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:type':Environment' :: EnvironmentType
type' = EnvironmentType
pType_,
      $sel:arn:Environment' :: Text
arn = Text
pArn_,
      $sel:ownerArn:Environment' :: Text
ownerArn = Text
pOwnerArn_
    }

-- | The connection type used for connecting to an Amazon EC2 environment.
-- @CONNECT_SSH@ is selected by default.
environment_connectionType :: Lens.Lens' Environment (Prelude.Maybe ConnectionType)
environment_connectionType :: Lens' Environment (Maybe ConnectionType)
environment_connectionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe ConnectionType
connectionType :: Maybe ConnectionType
$sel:connectionType:Environment' :: Environment -> Maybe ConnectionType
connectionType} -> Maybe ConnectionType
connectionType) (\s :: Environment
s@Environment' {} Maybe ConnectionType
a -> Environment
s {$sel:connectionType:Environment' :: Maybe ConnectionType
connectionType = Maybe ConnectionType
a} :: Environment)

-- | The description for 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.
environment_id :: Lens.Lens' Environment (Prelude.Maybe Prelude.Text)
environment_id :: Lens' Environment (Maybe Text)
environment_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe Text
id :: Maybe Text
$sel:id:Environment' :: Environment -> Maybe Text
id} -> Maybe Text
id) (\s :: Environment
s@Environment' {} Maybe Text
a -> Environment
s {$sel:id:Environment' :: Maybe Text
id = Maybe Text
a} :: Environment)

-- | The state of the environment in its creation or deletion lifecycle.
environment_lifecycle :: Lens.Lens' Environment (Prelude.Maybe EnvironmentLifecycle)
environment_lifecycle :: Lens' Environment (Maybe EnvironmentLifecycle)
environment_lifecycle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe EnvironmentLifecycle
lifecycle :: Maybe EnvironmentLifecycle
$sel:lifecycle:Environment' :: Environment -> Maybe EnvironmentLifecycle
lifecycle} -> Maybe EnvironmentLifecycle
lifecycle) (\s :: Environment
s@Environment' {} Maybe EnvironmentLifecycle
a -> Environment
s {$sel:lifecycle:Environment' :: Maybe EnvironmentLifecycle
lifecycle = Maybe EnvironmentLifecycle
a} :: Environment)

-- | Describes the status of Amazon Web Services managed temporary
-- credentials for the Cloud9 environment. Available values are:
--
-- -   @ENABLED_ON_CREATE@
--
-- -   @ENABLED_BY_OWNER@
--
-- -   @DISABLED_BY_DEFAULT@
--
-- -   @DISABLED_BY_OWNER@
--
-- -   @DISABLED_BY_COLLABORATOR@
--
-- -   @PENDING_REMOVAL_BY_COLLABORATOR@
--
-- -   @PENDING_REMOVAL_BY_OWNER@
--
-- -   @FAILED_REMOVAL_BY_COLLABORATOR@
--
-- -   @ENABLED_BY_OWNER@
--
-- -   @DISABLED_BY_DEFAULT@
environment_managedCredentialsStatus :: Lens.Lens' Environment (Prelude.Maybe ManagedCredentialsStatus)
environment_managedCredentialsStatus :: Lens' Environment (Maybe ManagedCredentialsStatus)
environment_managedCredentialsStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Maybe ManagedCredentialsStatus
managedCredentialsStatus :: Maybe ManagedCredentialsStatus
$sel:managedCredentialsStatus:Environment' :: Environment -> Maybe ManagedCredentialsStatus
managedCredentialsStatus} -> Maybe ManagedCredentialsStatus
managedCredentialsStatus) (\s :: Environment
s@Environment' {} Maybe ManagedCredentialsStatus
a -> Environment
s {$sel:managedCredentialsStatus:Environment' :: Maybe ManagedCredentialsStatus
managedCredentialsStatus = Maybe ManagedCredentialsStatus
a} :: Environment)

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

-- | The type of environment. Valid values include the following:
--
-- -   @ec2@: An Amazon Elastic Compute Cloud (Amazon EC2) instance
--     connects to the environment.
--
-- -   @ssh@: Your own server connects to the environment.
environment_type :: Lens.Lens' Environment EnvironmentType
environment_type :: Lens' Environment EnvironmentType
environment_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {EnvironmentType
type' :: EnvironmentType
$sel:type':Environment' :: Environment -> EnvironmentType
type'} -> EnvironmentType
type') (\s :: Environment
s@Environment' {} EnvironmentType
a -> Environment
s {$sel:type':Environment' :: EnvironmentType
type' = EnvironmentType
a} :: Environment)

-- | 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 Amazon Resource Name (ARN) of the environment owner.
environment_ownerArn :: Lens.Lens' Environment Prelude.Text
environment_ownerArn :: Lens' Environment Text
environment_ownerArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Environment' {Text
ownerArn :: Text
$sel:ownerArn:Environment' :: Environment -> Text
ownerArn} -> Text
ownerArn) (\s :: Environment
s@Environment' {} Text
a -> Environment
s {$sel:ownerArn:Environment' :: Text
ownerArn = 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 ConnectionType
-> Maybe (Sensitive Text)
-> Maybe Text
-> Maybe EnvironmentLifecycle
-> Maybe ManagedCredentialsStatus
-> Maybe Text
-> EnvironmentType
-> 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
"connectionType")
            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
"id")
            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
"lifecycle")
            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
"managedCredentialsStatus")
            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
"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
"type")
            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
"ownerArn")
      )

instance Prelude.Hashable Environment where
  hashWithSalt :: Int -> Environment -> Int
hashWithSalt Int
_salt Environment' {Maybe Text
Maybe (Sensitive Text)
Maybe ConnectionType
Maybe EnvironmentLifecycle
Maybe ManagedCredentialsStatus
Text
EnvironmentType
ownerArn :: Text
arn :: Text
type' :: EnvironmentType
name :: Maybe Text
managedCredentialsStatus :: Maybe ManagedCredentialsStatus
lifecycle :: Maybe EnvironmentLifecycle
id :: Maybe Text
description :: Maybe (Sensitive Text)
connectionType :: Maybe ConnectionType
$sel:ownerArn:Environment' :: Environment -> Text
$sel:arn:Environment' :: Environment -> Text
$sel:type':Environment' :: Environment -> EnvironmentType
$sel:name:Environment' :: Environment -> Maybe Text
$sel:managedCredentialsStatus:Environment' :: Environment -> Maybe ManagedCredentialsStatus
$sel:lifecycle:Environment' :: Environment -> Maybe EnvironmentLifecycle
$sel:id:Environment' :: Environment -> Maybe Text
$sel:description:Environment' :: Environment -> Maybe (Sensitive Text)
$sel:connectionType:Environment' :: Environment -> Maybe ConnectionType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConnectionType
connectionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EnvironmentLifecycle
lifecycle
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ManagedCredentialsStatus
managedCredentialsStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EnvironmentType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ownerArn

instance Prelude.NFData Environment where
  rnf :: Environment -> ()
rnf Environment' {Maybe Text
Maybe (Sensitive Text)
Maybe ConnectionType
Maybe EnvironmentLifecycle
Maybe ManagedCredentialsStatus
Text
EnvironmentType
ownerArn :: Text
arn :: Text
type' :: EnvironmentType
name :: Maybe Text
managedCredentialsStatus :: Maybe ManagedCredentialsStatus
lifecycle :: Maybe EnvironmentLifecycle
id :: Maybe Text
description :: Maybe (Sensitive Text)
connectionType :: Maybe ConnectionType
$sel:ownerArn:Environment' :: Environment -> Text
$sel:arn:Environment' :: Environment -> Text
$sel:type':Environment' :: Environment -> EnvironmentType
$sel:name:Environment' :: Environment -> Maybe Text
$sel:managedCredentialsStatus:Environment' :: Environment -> Maybe ManagedCredentialsStatus
$sel:lifecycle:Environment' :: Environment -> Maybe EnvironmentLifecycle
$sel:id:Environment' :: Environment -> Maybe Text
$sel:description:Environment' :: Environment -> Maybe (Sensitive Text)
$sel:connectionType:Environment' :: Environment -> Maybe ConnectionType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ConnectionType
connectionType
      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
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EnvironmentLifecycle
lifecycle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ManagedCredentialsStatus
managedCredentialsStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf EnvironmentType
type'
      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 Text
ownerArn