{-# 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.M2.GetEnvironment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes a specific runtime environment.
module Amazonka.M2.GetEnvironment
  ( -- * Creating a Request
    GetEnvironment (..),
    newGetEnvironment,

    -- * Request Lenses
    getEnvironment_environmentId,

    -- * Destructuring the Response
    GetEnvironmentResponse (..),
    newGetEnvironmentResponse,

    -- * Response Lenses
    getEnvironmentResponse_actualCapacity,
    getEnvironmentResponse_description,
    getEnvironmentResponse_highAvailabilityConfig,
    getEnvironmentResponse_kmsKeyId,
    getEnvironmentResponse_loadBalancerArn,
    getEnvironmentResponse_pendingMaintenance,
    getEnvironmentResponse_preferredMaintenanceWindow,
    getEnvironmentResponse_publiclyAccessible,
    getEnvironmentResponse_statusReason,
    getEnvironmentResponse_storageConfigurations,
    getEnvironmentResponse_tags,
    getEnvironmentResponse_httpStatus,
    getEnvironmentResponse_creationTime,
    getEnvironmentResponse_engineType,
    getEnvironmentResponse_engineVersion,
    getEnvironmentResponse_environmentArn,
    getEnvironmentResponse_environmentId,
    getEnvironmentResponse_instanceType,
    getEnvironmentResponse_name,
    getEnvironmentResponse_securityGroupIds,
    getEnvironmentResponse_status,
    getEnvironmentResponse_subnetIds,
    getEnvironmentResponse_vpcId,
  )
where

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

-- | /See:/ 'newGetEnvironment' smart constructor.
data GetEnvironment = GetEnvironment'
  { -- | The unique identifier of the runtime environment.
    GetEnvironment -> Text
environmentId :: Prelude.Text
  }
  deriving (GetEnvironment -> GetEnvironment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetEnvironment -> GetEnvironment -> Bool
$c/= :: GetEnvironment -> GetEnvironment -> Bool
== :: GetEnvironment -> GetEnvironment -> Bool
$c== :: GetEnvironment -> GetEnvironment -> Bool
Prelude.Eq, ReadPrec [GetEnvironment]
ReadPrec GetEnvironment
Int -> ReadS GetEnvironment
ReadS [GetEnvironment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetEnvironment]
$creadListPrec :: ReadPrec [GetEnvironment]
readPrec :: ReadPrec GetEnvironment
$creadPrec :: ReadPrec GetEnvironment
readList :: ReadS [GetEnvironment]
$creadList :: ReadS [GetEnvironment]
readsPrec :: Int -> ReadS GetEnvironment
$creadsPrec :: Int -> ReadS GetEnvironment
Prelude.Read, Int -> GetEnvironment -> ShowS
[GetEnvironment] -> ShowS
GetEnvironment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetEnvironment] -> ShowS
$cshowList :: [GetEnvironment] -> ShowS
show :: GetEnvironment -> String
$cshow :: GetEnvironment -> String
showsPrec :: Int -> GetEnvironment -> ShowS
$cshowsPrec :: Int -> GetEnvironment -> ShowS
Prelude.Show, forall x. Rep GetEnvironment x -> GetEnvironment
forall x. GetEnvironment -> Rep GetEnvironment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetEnvironment x -> GetEnvironment
$cfrom :: forall x. GetEnvironment -> Rep GetEnvironment x
Prelude.Generic)

-- |
-- Create a value of 'GetEnvironment' 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:
--
-- 'environmentId', 'getEnvironment_environmentId' - The unique identifier of the runtime environment.
newGetEnvironment ::
  -- | 'environmentId'
  Prelude.Text ->
  GetEnvironment
newGetEnvironment :: Text -> GetEnvironment
newGetEnvironment Text
pEnvironmentId_ =
  GetEnvironment' {$sel:environmentId:GetEnvironment' :: Text
environmentId = Text
pEnvironmentId_}

-- | The unique identifier of the runtime environment.
getEnvironment_environmentId :: Lens.Lens' GetEnvironment Prelude.Text
getEnvironment_environmentId :: Lens' GetEnvironment Text
getEnvironment_environmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironment' {Text
environmentId :: Text
$sel:environmentId:GetEnvironment' :: GetEnvironment -> Text
environmentId} -> Text
environmentId) (\s :: GetEnvironment
s@GetEnvironment' {} Text
a -> GetEnvironment
s {$sel:environmentId:GetEnvironment' :: Text
environmentId = Text
a} :: GetEnvironment)

instance Core.AWSRequest GetEnvironment where
  type
    AWSResponse GetEnvironment =
      GetEnvironmentResponse
  request :: (Service -> Service) -> GetEnvironment -> Request GetEnvironment
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetEnvironment
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetEnvironment)))
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 Natural
-> Maybe Text
-> Maybe HighAvailabilityConfig
-> Maybe Text
-> Maybe Text
-> Maybe PendingMaintenance
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe [StorageConfiguration]
-> Maybe (HashMap Text Text)
-> Int
-> POSIX
-> EngineType
-> Text
-> Text
-> Text
-> Text
-> Text
-> [Text]
-> EnvironmentLifecycle
-> [Text]
-> Text
-> GetEnvironmentResponse
GetEnvironmentResponse'
            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
"actualCapacity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"highAvailabilityConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"kmsKeyId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"loadBalancerArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"pendingMaintenance")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"preferredMaintenanceWindow")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"publiclyAccessible")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"statusReason")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"storageConfigurations"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"creationTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"engineType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"engineVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"environmentArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"environmentId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"instanceType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String 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 -> Either String (Maybe a)
Data..?> Key
"securityGroupIds"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"subnetIds" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"vpcId")
      )

instance Prelude.Hashable GetEnvironment where
  hashWithSalt :: Int -> GetEnvironment -> Int
hashWithSalt Int
_salt GetEnvironment' {Text
environmentId :: Text
$sel:environmentId:GetEnvironment' :: GetEnvironment -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
environmentId

instance Prelude.NFData GetEnvironment where
  rnf :: GetEnvironment -> ()
rnf GetEnvironment' {Text
environmentId :: Text
$sel:environmentId:GetEnvironment' :: GetEnvironment -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
environmentId

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

instance Data.ToPath GetEnvironment where
  toPath :: GetEnvironment -> ByteString
toPath GetEnvironment' {Text
environmentId :: Text
$sel:environmentId:GetEnvironment' :: GetEnvironment -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/environments/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
environmentId]

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

-- | /See:/ 'newGetEnvironmentResponse' smart constructor.
data GetEnvironmentResponse = GetEnvironmentResponse'
  { -- | The number of instances included in the runtime environment. A
    -- standalone runtime environment has a maxiumum of one instance.
    -- Currently, a high availability runtime environment has a maximum of two
    -- instances.
    GetEnvironmentResponse -> Maybe Natural
actualCapacity :: Prelude.Maybe Prelude.Natural,
    -- | The description of the runtime environment.
    GetEnvironmentResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The desired capacity of the high availability configuration for the
    -- runtime environment.
    GetEnvironmentResponse -> Maybe HighAvailabilityConfig
highAvailabilityConfig :: Prelude.Maybe HighAvailabilityConfig,
    -- | The identifier of a customer managed key.
    GetEnvironmentResponse -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) for the load balancer used with the
    -- runtime environment.
    GetEnvironmentResponse -> Maybe Text
loadBalancerArn :: Prelude.Maybe Prelude.Text,
    -- | Indicates the pending maintenance scheduled on this environment.
    GetEnvironmentResponse -> Maybe PendingMaintenance
pendingMaintenance :: Prelude.Maybe PendingMaintenance,
    -- | Configures the maintenance window you want for the runtime environment.
    -- If you do not provide a value, a random system-generated value will be
    -- assigned.
    GetEnvironmentResponse -> Maybe Text
preferredMaintenanceWindow :: Prelude.Maybe Prelude.Text,
    -- | Whether applications running in this runtime environment are publicly
    -- accessible.
    GetEnvironmentResponse -> Maybe Bool
publiclyAccessible :: Prelude.Maybe Prelude.Bool,
    -- | The reason for the reported status.
    GetEnvironmentResponse -> Maybe Text
statusReason :: Prelude.Maybe Prelude.Text,
    -- | The storage configurations defined for the runtime environment.
    GetEnvironmentResponse -> Maybe [StorageConfiguration]
storageConfigurations :: Prelude.Maybe [StorageConfiguration],
    -- | The tags defined for this runtime environment.
    GetEnvironmentResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetEnvironmentResponse -> Int
httpStatus :: Prelude.Int,
    -- | The timestamp when the runtime environment was created.
    GetEnvironmentResponse -> POSIX
creationTime :: Data.POSIX,
    -- | The target platform for the runtime environment.
    GetEnvironmentResponse -> EngineType
engineType :: EngineType,
    -- | The version of the runtime engine.
    GetEnvironmentResponse -> Text
engineVersion :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the runtime environment.
    GetEnvironmentResponse -> Text
environmentArn :: Prelude.Text,
    -- | The unique identifier of the runtime environment.
    GetEnvironmentResponse -> Text
environmentId :: Prelude.Text,
    -- | The type of instance underlying the runtime environment.
    GetEnvironmentResponse -> Text
instanceType :: Prelude.Text,
    -- | The name of the runtime environment. Must be unique within the account.
    GetEnvironmentResponse -> Text
name :: Prelude.Text,
    -- | The unique identifiers of the security groups assigned to this runtime
    -- environment.
    GetEnvironmentResponse -> [Text]
securityGroupIds :: [Prelude.Text],
    -- | The status of the runtime environment.
    GetEnvironmentResponse -> EnvironmentLifecycle
status :: EnvironmentLifecycle,
    -- | The unique identifiers of the subnets assigned to this runtime
    -- environment.
    GetEnvironmentResponse -> [Text]
subnetIds :: [Prelude.Text],
    -- | The unique identifier for the VPC used with this runtime environment.
    GetEnvironmentResponse -> Text
vpcId :: Prelude.Text
  }
  deriving (GetEnvironmentResponse -> GetEnvironmentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetEnvironmentResponse -> GetEnvironmentResponse -> Bool
$c/= :: GetEnvironmentResponse -> GetEnvironmentResponse -> Bool
== :: GetEnvironmentResponse -> GetEnvironmentResponse -> Bool
$c== :: GetEnvironmentResponse -> GetEnvironmentResponse -> Bool
Prelude.Eq, ReadPrec [GetEnvironmentResponse]
ReadPrec GetEnvironmentResponse
Int -> ReadS GetEnvironmentResponse
ReadS [GetEnvironmentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetEnvironmentResponse]
$creadListPrec :: ReadPrec [GetEnvironmentResponse]
readPrec :: ReadPrec GetEnvironmentResponse
$creadPrec :: ReadPrec GetEnvironmentResponse
readList :: ReadS [GetEnvironmentResponse]
$creadList :: ReadS [GetEnvironmentResponse]
readsPrec :: Int -> ReadS GetEnvironmentResponse
$creadsPrec :: Int -> ReadS GetEnvironmentResponse
Prelude.Read, Int -> GetEnvironmentResponse -> ShowS
[GetEnvironmentResponse] -> ShowS
GetEnvironmentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetEnvironmentResponse] -> ShowS
$cshowList :: [GetEnvironmentResponse] -> ShowS
show :: GetEnvironmentResponse -> String
$cshow :: GetEnvironmentResponse -> String
showsPrec :: Int -> GetEnvironmentResponse -> ShowS
$cshowsPrec :: Int -> GetEnvironmentResponse -> ShowS
Prelude.Show, forall x. Rep GetEnvironmentResponse x -> GetEnvironmentResponse
forall x. GetEnvironmentResponse -> Rep GetEnvironmentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetEnvironmentResponse x -> GetEnvironmentResponse
$cfrom :: forall x. GetEnvironmentResponse -> Rep GetEnvironmentResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetEnvironmentResponse' 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:
--
-- 'actualCapacity', 'getEnvironmentResponse_actualCapacity' - The number of instances included in the runtime environment. A
-- standalone runtime environment has a maxiumum of one instance.
-- Currently, a high availability runtime environment has a maximum of two
-- instances.
--
-- 'description', 'getEnvironmentResponse_description' - The description of the runtime environment.
--
-- 'highAvailabilityConfig', 'getEnvironmentResponse_highAvailabilityConfig' - The desired capacity of the high availability configuration for the
-- runtime environment.
--
-- 'kmsKeyId', 'getEnvironmentResponse_kmsKeyId' - The identifier of a customer managed key.
--
-- 'loadBalancerArn', 'getEnvironmentResponse_loadBalancerArn' - The Amazon Resource Name (ARN) for the load balancer used with the
-- runtime environment.
--
-- 'pendingMaintenance', 'getEnvironmentResponse_pendingMaintenance' - Indicates the pending maintenance scheduled on this environment.
--
-- 'preferredMaintenanceWindow', 'getEnvironmentResponse_preferredMaintenanceWindow' - Configures the maintenance window you want for the runtime environment.
-- If you do not provide a value, a random system-generated value will be
-- assigned.
--
-- 'publiclyAccessible', 'getEnvironmentResponse_publiclyAccessible' - Whether applications running in this runtime environment are publicly
-- accessible.
--
-- 'statusReason', 'getEnvironmentResponse_statusReason' - The reason for the reported status.
--
-- 'storageConfigurations', 'getEnvironmentResponse_storageConfigurations' - The storage configurations defined for the runtime environment.
--
-- 'tags', 'getEnvironmentResponse_tags' - The tags defined for this runtime environment.
--
-- 'httpStatus', 'getEnvironmentResponse_httpStatus' - The response's http status code.
--
-- 'creationTime', 'getEnvironmentResponse_creationTime' - The timestamp when the runtime environment was created.
--
-- 'engineType', 'getEnvironmentResponse_engineType' - The target platform for the runtime environment.
--
-- 'engineVersion', 'getEnvironmentResponse_engineVersion' - The version of the runtime engine.
--
-- 'environmentArn', 'getEnvironmentResponse_environmentArn' - The Amazon Resource Name (ARN) of the runtime environment.
--
-- 'environmentId', 'getEnvironmentResponse_environmentId' - The unique identifier of the runtime environment.
--
-- 'instanceType', 'getEnvironmentResponse_instanceType' - The type of instance underlying the runtime environment.
--
-- 'name', 'getEnvironmentResponse_name' - The name of the runtime environment. Must be unique within the account.
--
-- 'securityGroupIds', 'getEnvironmentResponse_securityGroupIds' - The unique identifiers of the security groups assigned to this runtime
-- environment.
--
-- 'status', 'getEnvironmentResponse_status' - The status of the runtime environment.
--
-- 'subnetIds', 'getEnvironmentResponse_subnetIds' - The unique identifiers of the subnets assigned to this runtime
-- environment.
--
-- 'vpcId', 'getEnvironmentResponse_vpcId' - The unique identifier for the VPC used with this runtime environment.
newGetEnvironmentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'engineType'
  EngineType ->
  -- | 'engineVersion'
  Prelude.Text ->
  -- | 'environmentArn'
  Prelude.Text ->
  -- | 'environmentId'
  Prelude.Text ->
  -- | 'instanceType'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'status'
  EnvironmentLifecycle ->
  -- | 'vpcId'
  Prelude.Text ->
  GetEnvironmentResponse
newGetEnvironmentResponse :: Int
-> UTCTime
-> EngineType
-> Text
-> Text
-> Text
-> Text
-> Text
-> EnvironmentLifecycle
-> Text
-> GetEnvironmentResponse
newGetEnvironmentResponse
  Int
pHttpStatus_
  UTCTime
pCreationTime_
  EngineType
pEngineType_
  Text
pEngineVersion_
  Text
pEnvironmentArn_
  Text
pEnvironmentId_
  Text
pInstanceType_
  Text
pName_
  EnvironmentLifecycle
pStatus_
  Text
pVpcId_ =
    GetEnvironmentResponse'
      { $sel:actualCapacity:GetEnvironmentResponse' :: Maybe Natural
actualCapacity =
          forall a. Maybe a
Prelude.Nothing,
        $sel:description:GetEnvironmentResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:highAvailabilityConfig:GetEnvironmentResponse' :: Maybe HighAvailabilityConfig
highAvailabilityConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:GetEnvironmentResponse' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:loadBalancerArn:GetEnvironmentResponse' :: Maybe Text
loadBalancerArn = forall a. Maybe a
Prelude.Nothing,
        $sel:pendingMaintenance:GetEnvironmentResponse' :: Maybe PendingMaintenance
pendingMaintenance = forall a. Maybe a
Prelude.Nothing,
        $sel:preferredMaintenanceWindow:GetEnvironmentResponse' :: Maybe Text
preferredMaintenanceWindow = forall a. Maybe a
Prelude.Nothing,
        $sel:publiclyAccessible:GetEnvironmentResponse' :: Maybe Bool
publiclyAccessible = forall a. Maybe a
Prelude.Nothing,
        $sel:statusReason:GetEnvironmentResponse' :: Maybe Text
statusReason = forall a. Maybe a
Prelude.Nothing,
        $sel:storageConfigurations:GetEnvironmentResponse' :: Maybe [StorageConfiguration]
storageConfigurations = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:GetEnvironmentResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetEnvironmentResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:creationTime:GetEnvironmentResponse' :: POSIX
creationTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:engineType:GetEnvironmentResponse' :: EngineType
engineType = EngineType
pEngineType_,
        $sel:engineVersion:GetEnvironmentResponse' :: Text
engineVersion = Text
pEngineVersion_,
        $sel:environmentArn:GetEnvironmentResponse' :: Text
environmentArn = Text
pEnvironmentArn_,
        $sel:environmentId:GetEnvironmentResponse' :: Text
environmentId = Text
pEnvironmentId_,
        $sel:instanceType:GetEnvironmentResponse' :: Text
instanceType = Text
pInstanceType_,
        $sel:name:GetEnvironmentResponse' :: Text
name = Text
pName_,
        $sel:securityGroupIds:GetEnvironmentResponse' :: [Text]
securityGroupIds = forall a. Monoid a => a
Prelude.mempty,
        $sel:status:GetEnvironmentResponse' :: EnvironmentLifecycle
status = EnvironmentLifecycle
pStatus_,
        $sel:subnetIds:GetEnvironmentResponse' :: [Text]
subnetIds = forall a. Monoid a => a
Prelude.mempty,
        $sel:vpcId:GetEnvironmentResponse' :: Text
vpcId = Text
pVpcId_
      }

-- | The number of instances included in the runtime environment. A
-- standalone runtime environment has a maxiumum of one instance.
-- Currently, a high availability runtime environment has a maximum of two
-- instances.
getEnvironmentResponse_actualCapacity :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe Prelude.Natural)
getEnvironmentResponse_actualCapacity :: Lens' GetEnvironmentResponse (Maybe Natural)
getEnvironmentResponse_actualCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe Natural
actualCapacity :: Maybe Natural
$sel:actualCapacity:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Natural
actualCapacity} -> Maybe Natural
actualCapacity) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe Natural
a -> GetEnvironmentResponse
s {$sel:actualCapacity:GetEnvironmentResponse' :: Maybe Natural
actualCapacity = Maybe Natural
a} :: GetEnvironmentResponse)

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

-- | The desired capacity of the high availability configuration for the
-- runtime environment.
getEnvironmentResponse_highAvailabilityConfig :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe HighAvailabilityConfig)
getEnvironmentResponse_highAvailabilityConfig :: Lens' GetEnvironmentResponse (Maybe HighAvailabilityConfig)
getEnvironmentResponse_highAvailabilityConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe HighAvailabilityConfig
highAvailabilityConfig :: Maybe HighAvailabilityConfig
$sel:highAvailabilityConfig:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe HighAvailabilityConfig
highAvailabilityConfig} -> Maybe HighAvailabilityConfig
highAvailabilityConfig) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe HighAvailabilityConfig
a -> GetEnvironmentResponse
s {$sel:highAvailabilityConfig:GetEnvironmentResponse' :: Maybe HighAvailabilityConfig
highAvailabilityConfig = Maybe HighAvailabilityConfig
a} :: GetEnvironmentResponse)

-- | The identifier of a customer managed key.
getEnvironmentResponse_kmsKeyId :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe Prelude.Text)
getEnvironmentResponse_kmsKeyId :: Lens' GetEnvironmentResponse (Maybe Text)
getEnvironmentResponse_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe Text
a -> GetEnvironmentResponse
s {$sel:kmsKeyId:GetEnvironmentResponse' :: Maybe Text
kmsKeyId = Maybe Text
a} :: GetEnvironmentResponse)

-- | The Amazon Resource Name (ARN) for the load balancer used with the
-- runtime environment.
getEnvironmentResponse_loadBalancerArn :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe Prelude.Text)
getEnvironmentResponse_loadBalancerArn :: Lens' GetEnvironmentResponse (Maybe Text)
getEnvironmentResponse_loadBalancerArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe Text
loadBalancerArn :: Maybe Text
$sel:loadBalancerArn:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Text
loadBalancerArn} -> Maybe Text
loadBalancerArn) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe Text
a -> GetEnvironmentResponse
s {$sel:loadBalancerArn:GetEnvironmentResponse' :: Maybe Text
loadBalancerArn = Maybe Text
a} :: GetEnvironmentResponse)

-- | Indicates the pending maintenance scheduled on this environment.
getEnvironmentResponse_pendingMaintenance :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe PendingMaintenance)
getEnvironmentResponse_pendingMaintenance :: Lens' GetEnvironmentResponse (Maybe PendingMaintenance)
getEnvironmentResponse_pendingMaintenance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe PendingMaintenance
pendingMaintenance :: Maybe PendingMaintenance
$sel:pendingMaintenance:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe PendingMaintenance
pendingMaintenance} -> Maybe PendingMaintenance
pendingMaintenance) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe PendingMaintenance
a -> GetEnvironmentResponse
s {$sel:pendingMaintenance:GetEnvironmentResponse' :: Maybe PendingMaintenance
pendingMaintenance = Maybe PendingMaintenance
a} :: GetEnvironmentResponse)

-- | Configures the maintenance window you want for the runtime environment.
-- If you do not provide a value, a random system-generated value will be
-- assigned.
getEnvironmentResponse_preferredMaintenanceWindow :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe Prelude.Text)
getEnvironmentResponse_preferredMaintenanceWindow :: Lens' GetEnvironmentResponse (Maybe Text)
getEnvironmentResponse_preferredMaintenanceWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe Text
preferredMaintenanceWindow :: Maybe Text
$sel:preferredMaintenanceWindow:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Text
preferredMaintenanceWindow} -> Maybe Text
preferredMaintenanceWindow) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe Text
a -> GetEnvironmentResponse
s {$sel:preferredMaintenanceWindow:GetEnvironmentResponse' :: Maybe Text
preferredMaintenanceWindow = Maybe Text
a} :: GetEnvironmentResponse)

-- | Whether applications running in this runtime environment are publicly
-- accessible.
getEnvironmentResponse_publiclyAccessible :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe Prelude.Bool)
getEnvironmentResponse_publiclyAccessible :: Lens' GetEnvironmentResponse (Maybe Bool)
getEnvironmentResponse_publiclyAccessible = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe Bool
publiclyAccessible :: Maybe Bool
$sel:publiclyAccessible:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Bool
publiclyAccessible} -> Maybe Bool
publiclyAccessible) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe Bool
a -> GetEnvironmentResponse
s {$sel:publiclyAccessible:GetEnvironmentResponse' :: Maybe Bool
publiclyAccessible = Maybe Bool
a} :: GetEnvironmentResponse)

-- | The reason for the reported status.
getEnvironmentResponse_statusReason :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe Prelude.Text)
getEnvironmentResponse_statusReason :: Lens' GetEnvironmentResponse (Maybe Text)
getEnvironmentResponse_statusReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe Text
statusReason :: Maybe Text
$sel:statusReason:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Text
statusReason} -> Maybe Text
statusReason) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe Text
a -> GetEnvironmentResponse
s {$sel:statusReason:GetEnvironmentResponse' :: Maybe Text
statusReason = Maybe Text
a} :: GetEnvironmentResponse)

-- | The storage configurations defined for the runtime environment.
getEnvironmentResponse_storageConfigurations :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe [StorageConfiguration])
getEnvironmentResponse_storageConfigurations :: Lens' GetEnvironmentResponse (Maybe [StorageConfiguration])
getEnvironmentResponse_storageConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe [StorageConfiguration]
storageConfigurations :: Maybe [StorageConfiguration]
$sel:storageConfigurations:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe [StorageConfiguration]
storageConfigurations} -> Maybe [StorageConfiguration]
storageConfigurations) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe [StorageConfiguration]
a -> GetEnvironmentResponse
s {$sel:storageConfigurations:GetEnvironmentResponse' :: Maybe [StorageConfiguration]
storageConfigurations = Maybe [StorageConfiguration]
a} :: GetEnvironmentResponse) 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 tags defined for this runtime environment.
getEnvironmentResponse_tags :: Lens.Lens' GetEnvironmentResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getEnvironmentResponse_tags :: Lens' GetEnvironmentResponse (Maybe (HashMap Text Text))
getEnvironmentResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Maybe (HashMap Text Text)
a -> GetEnvironmentResponse
s {$sel:tags:GetEnvironmentResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetEnvironmentResponse) 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 response's http status code.
getEnvironmentResponse_httpStatus :: Lens.Lens' GetEnvironmentResponse Prelude.Int
getEnvironmentResponse_httpStatus :: Lens' GetEnvironmentResponse Int
getEnvironmentResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetEnvironmentResponse' :: GetEnvironmentResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Int
a -> GetEnvironmentResponse
s {$sel:httpStatus:GetEnvironmentResponse' :: Int
httpStatus = Int
a} :: GetEnvironmentResponse)

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

-- | The target platform for the runtime environment.
getEnvironmentResponse_engineType :: Lens.Lens' GetEnvironmentResponse EngineType
getEnvironmentResponse_engineType :: Lens' GetEnvironmentResponse EngineType
getEnvironmentResponse_engineType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {EngineType
engineType :: EngineType
$sel:engineType:GetEnvironmentResponse' :: GetEnvironmentResponse -> EngineType
engineType} -> EngineType
engineType) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} EngineType
a -> GetEnvironmentResponse
s {$sel:engineType:GetEnvironmentResponse' :: EngineType
engineType = EngineType
a} :: GetEnvironmentResponse)

-- | The version of the runtime engine.
getEnvironmentResponse_engineVersion :: Lens.Lens' GetEnvironmentResponse Prelude.Text
getEnvironmentResponse_engineVersion :: Lens' GetEnvironmentResponse Text
getEnvironmentResponse_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Text
engineVersion :: Text
$sel:engineVersion:GetEnvironmentResponse' :: GetEnvironmentResponse -> Text
engineVersion} -> Text
engineVersion) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Text
a -> GetEnvironmentResponse
s {$sel:engineVersion:GetEnvironmentResponse' :: Text
engineVersion = Text
a} :: GetEnvironmentResponse)

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

-- | The unique identifier of the runtime environment.
getEnvironmentResponse_environmentId :: Lens.Lens' GetEnvironmentResponse Prelude.Text
getEnvironmentResponse_environmentId :: Lens' GetEnvironmentResponse Text
getEnvironmentResponse_environmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Text
environmentId :: Text
$sel:environmentId:GetEnvironmentResponse' :: GetEnvironmentResponse -> Text
environmentId} -> Text
environmentId) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Text
a -> GetEnvironmentResponse
s {$sel:environmentId:GetEnvironmentResponse' :: Text
environmentId = Text
a} :: GetEnvironmentResponse)

-- | The type of instance underlying the runtime environment.
getEnvironmentResponse_instanceType :: Lens.Lens' GetEnvironmentResponse Prelude.Text
getEnvironmentResponse_instanceType :: Lens' GetEnvironmentResponse Text
getEnvironmentResponse_instanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Text
instanceType :: Text
$sel:instanceType:GetEnvironmentResponse' :: GetEnvironmentResponse -> Text
instanceType} -> Text
instanceType) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Text
a -> GetEnvironmentResponse
s {$sel:instanceType:GetEnvironmentResponse' :: Text
instanceType = Text
a} :: GetEnvironmentResponse)

-- | The name of the runtime environment. Must be unique within the account.
getEnvironmentResponse_name :: Lens.Lens' GetEnvironmentResponse Prelude.Text
getEnvironmentResponse_name :: Lens' GetEnvironmentResponse Text
getEnvironmentResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Text
name :: Text
$sel:name:GetEnvironmentResponse' :: GetEnvironmentResponse -> Text
name} -> Text
name) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Text
a -> GetEnvironmentResponse
s {$sel:name:GetEnvironmentResponse' :: Text
name = Text
a} :: GetEnvironmentResponse)

-- | The unique identifiers of the security groups assigned to this runtime
-- environment.
getEnvironmentResponse_securityGroupIds :: Lens.Lens' GetEnvironmentResponse [Prelude.Text]
getEnvironmentResponse_securityGroupIds :: Lens' GetEnvironmentResponse [Text]
getEnvironmentResponse_securityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {[Text]
securityGroupIds :: [Text]
$sel:securityGroupIds:GetEnvironmentResponse' :: GetEnvironmentResponse -> [Text]
securityGroupIds} -> [Text]
securityGroupIds) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} [Text]
a -> GetEnvironmentResponse
s {$sel:securityGroupIds:GetEnvironmentResponse' :: [Text]
securityGroupIds = [Text]
a} :: GetEnvironmentResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The status of the runtime environment.
getEnvironmentResponse_status :: Lens.Lens' GetEnvironmentResponse EnvironmentLifecycle
getEnvironmentResponse_status :: Lens' GetEnvironmentResponse EnvironmentLifecycle
getEnvironmentResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {EnvironmentLifecycle
status :: EnvironmentLifecycle
$sel:status:GetEnvironmentResponse' :: GetEnvironmentResponse -> EnvironmentLifecycle
status} -> EnvironmentLifecycle
status) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} EnvironmentLifecycle
a -> GetEnvironmentResponse
s {$sel:status:GetEnvironmentResponse' :: EnvironmentLifecycle
status = EnvironmentLifecycle
a} :: GetEnvironmentResponse)

-- | The unique identifiers of the subnets assigned to this runtime
-- environment.
getEnvironmentResponse_subnetIds :: Lens.Lens' GetEnvironmentResponse [Prelude.Text]
getEnvironmentResponse_subnetIds :: Lens' GetEnvironmentResponse [Text]
getEnvironmentResponse_subnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {[Text]
subnetIds :: [Text]
$sel:subnetIds:GetEnvironmentResponse' :: GetEnvironmentResponse -> [Text]
subnetIds} -> [Text]
subnetIds) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} [Text]
a -> GetEnvironmentResponse
s {$sel:subnetIds:GetEnvironmentResponse' :: [Text]
subnetIds = [Text]
a} :: GetEnvironmentResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The unique identifier for the VPC used with this runtime environment.
getEnvironmentResponse_vpcId :: Lens.Lens' GetEnvironmentResponse Prelude.Text
getEnvironmentResponse_vpcId :: Lens' GetEnvironmentResponse Text
getEnvironmentResponse_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEnvironmentResponse' {Text
vpcId :: Text
$sel:vpcId:GetEnvironmentResponse' :: GetEnvironmentResponse -> Text
vpcId} -> Text
vpcId) (\s :: GetEnvironmentResponse
s@GetEnvironmentResponse' {} Text
a -> GetEnvironmentResponse
s {$sel:vpcId:GetEnvironmentResponse' :: Text
vpcId = Text
a} :: GetEnvironmentResponse)

instance Prelude.NFData GetEnvironmentResponse where
  rnf :: GetEnvironmentResponse -> ()
rnf GetEnvironmentResponse' {Int
[Text]
Maybe Bool
Maybe Natural
Maybe [StorageConfiguration]
Maybe Text
Maybe (HashMap Text Text)
Maybe HighAvailabilityConfig
Maybe PendingMaintenance
Text
POSIX
EngineType
EnvironmentLifecycle
vpcId :: Text
subnetIds :: [Text]
status :: EnvironmentLifecycle
securityGroupIds :: [Text]
name :: Text
instanceType :: Text
environmentId :: Text
environmentArn :: Text
engineVersion :: Text
engineType :: EngineType
creationTime :: POSIX
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
storageConfigurations :: Maybe [StorageConfiguration]
statusReason :: Maybe Text
publiclyAccessible :: Maybe Bool
preferredMaintenanceWindow :: Maybe Text
pendingMaintenance :: Maybe PendingMaintenance
loadBalancerArn :: Maybe Text
kmsKeyId :: Maybe Text
highAvailabilityConfig :: Maybe HighAvailabilityConfig
description :: Maybe Text
actualCapacity :: Maybe Natural
$sel:vpcId:GetEnvironmentResponse' :: GetEnvironmentResponse -> Text
$sel:subnetIds:GetEnvironmentResponse' :: GetEnvironmentResponse -> [Text]
$sel:status:GetEnvironmentResponse' :: GetEnvironmentResponse -> EnvironmentLifecycle
$sel:securityGroupIds:GetEnvironmentResponse' :: GetEnvironmentResponse -> [Text]
$sel:name:GetEnvironmentResponse' :: GetEnvironmentResponse -> Text
$sel:instanceType:GetEnvironmentResponse' :: GetEnvironmentResponse -> Text
$sel:environmentId:GetEnvironmentResponse' :: GetEnvironmentResponse -> Text
$sel:environmentArn:GetEnvironmentResponse' :: GetEnvironmentResponse -> Text
$sel:engineVersion:GetEnvironmentResponse' :: GetEnvironmentResponse -> Text
$sel:engineType:GetEnvironmentResponse' :: GetEnvironmentResponse -> EngineType
$sel:creationTime:GetEnvironmentResponse' :: GetEnvironmentResponse -> POSIX
$sel:httpStatus:GetEnvironmentResponse' :: GetEnvironmentResponse -> Int
$sel:tags:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe (HashMap Text Text)
$sel:storageConfigurations:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe [StorageConfiguration]
$sel:statusReason:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Text
$sel:publiclyAccessible:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Bool
$sel:preferredMaintenanceWindow:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Text
$sel:pendingMaintenance:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe PendingMaintenance
$sel:loadBalancerArn:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Text
$sel:kmsKeyId:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Text
$sel:highAvailabilityConfig:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe HighAvailabilityConfig
$sel:description:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Text
$sel:actualCapacity:GetEnvironmentResponse' :: GetEnvironmentResponse -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
actualCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HighAvailabilityConfig
highAvailabilityConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
loadBalancerArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PendingMaintenance
pendingMaintenance
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
preferredMaintenanceWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
publiclyAccessible
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [StorageConfiguration]
storageConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf EngineType
engineType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
engineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
environmentArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
environmentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceType
      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]
securityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf EnvironmentLifecycle
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
subnetIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vpcId