{-# 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.GetApplication
-- 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 the details of a specific application.
module Amazonka.M2.GetApplication
  ( -- * Creating a Request
    GetApplication (..),
    newGetApplication,

    -- * Request Lenses
    getApplication_applicationId,

    -- * Destructuring the Response
    GetApplicationResponse (..),
    newGetApplicationResponse,

    -- * Response Lenses
    getApplicationResponse_deployedVersion,
    getApplicationResponse_description,
    getApplicationResponse_environmentId,
    getApplicationResponse_kmsKeyId,
    getApplicationResponse_lastStartTime,
    getApplicationResponse_listenerArns,
    getApplicationResponse_listenerPorts,
    getApplicationResponse_loadBalancerDnsName,
    getApplicationResponse_logGroups,
    getApplicationResponse_statusReason,
    getApplicationResponse_tags,
    getApplicationResponse_targetGroupArns,
    getApplicationResponse_httpStatus,
    getApplicationResponse_applicationArn,
    getApplicationResponse_applicationId,
    getApplicationResponse_creationTime,
    getApplicationResponse_engineType,
    getApplicationResponse_latestVersion,
    getApplicationResponse_name,
    getApplicationResponse_status,
  )
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:/ 'newGetApplication' smart constructor.
data GetApplication = GetApplication'
  { -- | The identifier of the application.
    GetApplication -> Text
applicationId :: Prelude.Text
  }
  deriving (GetApplication -> GetApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApplication -> GetApplication -> Bool
$c/= :: GetApplication -> GetApplication -> Bool
== :: GetApplication -> GetApplication -> Bool
$c== :: GetApplication -> GetApplication -> Bool
Prelude.Eq, ReadPrec [GetApplication]
ReadPrec GetApplication
Int -> ReadS GetApplication
ReadS [GetApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApplication]
$creadListPrec :: ReadPrec [GetApplication]
readPrec :: ReadPrec GetApplication
$creadPrec :: ReadPrec GetApplication
readList :: ReadS [GetApplication]
$creadList :: ReadS [GetApplication]
readsPrec :: Int -> ReadS GetApplication
$creadsPrec :: Int -> ReadS GetApplication
Prelude.Read, Int -> GetApplication -> ShowS
[GetApplication] -> ShowS
GetApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApplication] -> ShowS
$cshowList :: [GetApplication] -> ShowS
show :: GetApplication -> String
$cshow :: GetApplication -> String
showsPrec :: Int -> GetApplication -> ShowS
$cshowsPrec :: Int -> GetApplication -> ShowS
Prelude.Show, forall x. Rep GetApplication x -> GetApplication
forall x. GetApplication -> Rep GetApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetApplication x -> GetApplication
$cfrom :: forall x. GetApplication -> Rep GetApplication x
Prelude.Generic)

-- |
-- Create a value of 'GetApplication' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'applicationId', 'getApplication_applicationId' - The identifier of the application.
newGetApplication ::
  -- | 'applicationId'
  Prelude.Text ->
  GetApplication
newGetApplication :: Text -> GetApplication
newGetApplication Text
pApplicationId_ =
  GetApplication' {$sel:applicationId:GetApplication' :: Text
applicationId = Text
pApplicationId_}

-- | The identifier of the application.
getApplication_applicationId :: Lens.Lens' GetApplication Prelude.Text
getApplication_applicationId :: Lens' GetApplication Text
getApplication_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplication' {Text
applicationId :: Text
$sel:applicationId:GetApplication' :: GetApplication -> Text
applicationId} -> Text
applicationId) (\s :: GetApplication
s@GetApplication' {} Text
a -> GetApplication
s {$sel:applicationId:GetApplication' :: Text
applicationId = Text
a} :: GetApplication)

instance Core.AWSRequest GetApplication where
  type
    AWSResponse GetApplication =
      GetApplicationResponse
  request :: (Service -> Service) -> GetApplication -> Request GetApplication
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 GetApplication
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetApplication)))
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 DeployedVersionSummary
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty Int)
-> Maybe Text
-> Maybe [LogGroupSummary]
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe (NonEmpty Text)
-> Int
-> Text
-> Text
-> POSIX
-> EngineType
-> ApplicationVersionSummary
-> Text
-> ApplicationLifecycle
-> GetApplicationResponse
GetApplicationResponse'
            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
"deployedVersion")
            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
"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 (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
"lastStartTime")
            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
"listenerArns")
            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
"listenerPorts")
            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
"loadBalancerDnsName")
            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
"logGroups" 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
"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
"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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"targetGroupArns")
            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
"applicationArn")
            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
"applicationId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String 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
"latestVersion")
            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 a
Data..:> Key
"status")
      )

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

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

instance Data.ToHeaders GetApplication where
  toHeaders :: GetApplication -> 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 GetApplication where
  toPath :: GetApplication -> ByteString
toPath GetApplication' {Text
applicationId :: Text
$sel:applicationId:GetApplication' :: GetApplication -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/applications/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId]

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

-- | /See:/ 'newGetApplicationResponse' smart constructor.
data GetApplicationResponse = GetApplicationResponse'
  { -- | The version of the application that is deployed.
    GetApplicationResponse -> Maybe DeployedVersionSummary
deployedVersion :: Prelude.Maybe DeployedVersionSummary,
    -- | The description of the application.
    GetApplicationResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the runtime environment where you want to deploy the
    -- application.
    GetApplicationResponse -> Maybe Text
environmentId :: Prelude.Maybe Prelude.Text,
    -- | The identifier of a customer managed key.
    GetApplicationResponse -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The timestamp when you last started the application. Null until the
    -- application runs for the first time.
    GetApplicationResponse -> Maybe POSIX
lastStartTime :: Prelude.Maybe Data.POSIX,
    -- | The Amazon Resource Name (ARN) for the network load balancer listener
    -- created in your Amazon Web Services account. Amazon Web Services
    -- Mainframe Modernization creates this listener for you the first time you
    -- deploy an application.
    GetApplicationResponse -> Maybe (NonEmpty Text)
listenerArns :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The port associated with the network load balancer listener created in
    -- your Amazon Web Services account.
    GetApplicationResponse -> Maybe (NonEmpty Int)
listenerPorts :: Prelude.Maybe (Prelude.NonEmpty Prelude.Int),
    -- | The public DNS name of the load balancer created in your Amazon Web
    -- Services account.
    GetApplicationResponse -> Maybe Text
loadBalancerDnsName :: Prelude.Maybe Prelude.Text,
    -- | The list of log summaries. Each log summary includes the log type as
    -- well as the log group identifier. These are CloudWatch logs. Amazon Web
    -- Services Mainframe Modernization pushes the application log to
    -- CloudWatch under the customer\'s account.
    GetApplicationResponse -> Maybe [LogGroupSummary]
logGroups :: Prelude.Maybe [LogGroupSummary],
    -- | The reason for the reported status.
    GetApplicationResponse -> Maybe Text
statusReason :: Prelude.Maybe Prelude.Text,
    -- | A list of tags associated with the application.
    GetApplicationResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Returns the Amazon Resource Names (ARNs) of the target groups that are
    -- attached to the network load balancer.
    GetApplicationResponse -> Maybe (NonEmpty Text)
targetGroupArns :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The response's http status code.
    GetApplicationResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the application.
    GetApplicationResponse -> Text
applicationArn :: Prelude.Text,
    -- | The identifier of the application.
    GetApplicationResponse -> Text
applicationId :: Prelude.Text,
    -- | The timestamp when this application was created.
    GetApplicationResponse -> POSIX
creationTime :: Data.POSIX,
    -- | The type of the target platform for the application.
    GetApplicationResponse -> EngineType
engineType :: EngineType,
    -- | The latest version of the application.
    GetApplicationResponse -> ApplicationVersionSummary
latestVersion :: ApplicationVersionSummary,
    -- | The unique identifier of the application.
    GetApplicationResponse -> Text
name :: Prelude.Text,
    -- | The status of the application.
    GetApplicationResponse -> ApplicationLifecycle
status :: ApplicationLifecycle
  }
  deriving (GetApplicationResponse -> GetApplicationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApplicationResponse -> GetApplicationResponse -> Bool
$c/= :: GetApplicationResponse -> GetApplicationResponse -> Bool
== :: GetApplicationResponse -> GetApplicationResponse -> Bool
$c== :: GetApplicationResponse -> GetApplicationResponse -> Bool
Prelude.Eq, ReadPrec [GetApplicationResponse]
ReadPrec GetApplicationResponse
Int -> ReadS GetApplicationResponse
ReadS [GetApplicationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApplicationResponse]
$creadListPrec :: ReadPrec [GetApplicationResponse]
readPrec :: ReadPrec GetApplicationResponse
$creadPrec :: ReadPrec GetApplicationResponse
readList :: ReadS [GetApplicationResponse]
$creadList :: ReadS [GetApplicationResponse]
readsPrec :: Int -> ReadS GetApplicationResponse
$creadsPrec :: Int -> ReadS GetApplicationResponse
Prelude.Read, Int -> GetApplicationResponse -> ShowS
[GetApplicationResponse] -> ShowS
GetApplicationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApplicationResponse] -> ShowS
$cshowList :: [GetApplicationResponse] -> ShowS
show :: GetApplicationResponse -> String
$cshow :: GetApplicationResponse -> String
showsPrec :: Int -> GetApplicationResponse -> ShowS
$cshowsPrec :: Int -> GetApplicationResponse -> ShowS
Prelude.Show, forall x. Rep GetApplicationResponse x -> GetApplicationResponse
forall x. GetApplicationResponse -> Rep GetApplicationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetApplicationResponse x -> GetApplicationResponse
$cfrom :: forall x. GetApplicationResponse -> Rep GetApplicationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetApplicationResponse' 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:
--
-- 'deployedVersion', 'getApplicationResponse_deployedVersion' - The version of the application that is deployed.
--
-- 'description', 'getApplicationResponse_description' - The description of the application.
--
-- 'environmentId', 'getApplicationResponse_environmentId' - The identifier of the runtime environment where you want to deploy the
-- application.
--
-- 'kmsKeyId', 'getApplicationResponse_kmsKeyId' - The identifier of a customer managed key.
--
-- 'lastStartTime', 'getApplicationResponse_lastStartTime' - The timestamp when you last started the application. Null until the
-- application runs for the first time.
--
-- 'listenerArns', 'getApplicationResponse_listenerArns' - The Amazon Resource Name (ARN) for the network load balancer listener
-- created in your Amazon Web Services account. Amazon Web Services
-- Mainframe Modernization creates this listener for you the first time you
-- deploy an application.
--
-- 'listenerPorts', 'getApplicationResponse_listenerPorts' - The port associated with the network load balancer listener created in
-- your Amazon Web Services account.
--
-- 'loadBalancerDnsName', 'getApplicationResponse_loadBalancerDnsName' - The public DNS name of the load balancer created in your Amazon Web
-- Services account.
--
-- 'logGroups', 'getApplicationResponse_logGroups' - The list of log summaries. Each log summary includes the log type as
-- well as the log group identifier. These are CloudWatch logs. Amazon Web
-- Services Mainframe Modernization pushes the application log to
-- CloudWatch under the customer\'s account.
--
-- 'statusReason', 'getApplicationResponse_statusReason' - The reason for the reported status.
--
-- 'tags', 'getApplicationResponse_tags' - A list of tags associated with the application.
--
-- 'targetGroupArns', 'getApplicationResponse_targetGroupArns' - Returns the Amazon Resource Names (ARNs) of the target groups that are
-- attached to the network load balancer.
--
-- 'httpStatus', 'getApplicationResponse_httpStatus' - The response's http status code.
--
-- 'applicationArn', 'getApplicationResponse_applicationArn' - The Amazon Resource Name (ARN) of the application.
--
-- 'applicationId', 'getApplicationResponse_applicationId' - The identifier of the application.
--
-- 'creationTime', 'getApplicationResponse_creationTime' - The timestamp when this application was created.
--
-- 'engineType', 'getApplicationResponse_engineType' - The type of the target platform for the application.
--
-- 'latestVersion', 'getApplicationResponse_latestVersion' - The latest version of the application.
--
-- 'name', 'getApplicationResponse_name' - The unique identifier of the application.
--
-- 'status', 'getApplicationResponse_status' - The status of the application.
newGetApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'applicationArn'
  Prelude.Text ->
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'engineType'
  EngineType ->
  -- | 'latestVersion'
  ApplicationVersionSummary ->
  -- | 'name'
  Prelude.Text ->
  -- | 'status'
  ApplicationLifecycle ->
  GetApplicationResponse
newGetApplicationResponse :: Int
-> Text
-> Text
-> UTCTime
-> EngineType
-> ApplicationVersionSummary
-> Text
-> ApplicationLifecycle
-> GetApplicationResponse
newGetApplicationResponse
  Int
pHttpStatus_
  Text
pApplicationArn_
  Text
pApplicationId_
  UTCTime
pCreationTime_
  EngineType
pEngineType_
  ApplicationVersionSummary
pLatestVersion_
  Text
pName_
  ApplicationLifecycle
pStatus_ =
    GetApplicationResponse'
      { $sel:deployedVersion:GetApplicationResponse' :: Maybe DeployedVersionSummary
deployedVersion =
          forall a. Maybe a
Prelude.Nothing,
        $sel:description:GetApplicationResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:environmentId:GetApplicationResponse' :: Maybe Text
environmentId = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:GetApplicationResponse' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:lastStartTime:GetApplicationResponse' :: Maybe POSIX
lastStartTime = forall a. Maybe a
Prelude.Nothing,
        $sel:listenerArns:GetApplicationResponse' :: Maybe (NonEmpty Text)
listenerArns = forall a. Maybe a
Prelude.Nothing,
        $sel:listenerPorts:GetApplicationResponse' :: Maybe (NonEmpty Int)
listenerPorts = forall a. Maybe a
Prelude.Nothing,
        $sel:loadBalancerDnsName:GetApplicationResponse' :: Maybe Text
loadBalancerDnsName = forall a. Maybe a
Prelude.Nothing,
        $sel:logGroups:GetApplicationResponse' :: Maybe [LogGroupSummary]
logGroups = forall a. Maybe a
Prelude.Nothing,
        $sel:statusReason:GetApplicationResponse' :: Maybe Text
statusReason = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:GetApplicationResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:targetGroupArns:GetApplicationResponse' :: Maybe (NonEmpty Text)
targetGroupArns = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetApplicationResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:applicationArn:GetApplicationResponse' :: Text
applicationArn = Text
pApplicationArn_,
        $sel:applicationId:GetApplicationResponse' :: Text
applicationId = Text
pApplicationId_,
        $sel:creationTime:GetApplicationResponse' :: POSIX
creationTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:engineType:GetApplicationResponse' :: EngineType
engineType = EngineType
pEngineType_,
        $sel:latestVersion:GetApplicationResponse' :: ApplicationVersionSummary
latestVersion = ApplicationVersionSummary
pLatestVersion_,
        $sel:name:GetApplicationResponse' :: Text
name = Text
pName_,
        $sel:status:GetApplicationResponse' :: ApplicationLifecycle
status = ApplicationLifecycle
pStatus_
      }

-- | The version of the application that is deployed.
getApplicationResponse_deployedVersion :: Lens.Lens' GetApplicationResponse (Prelude.Maybe DeployedVersionSummary)
getApplicationResponse_deployedVersion :: Lens' GetApplicationResponse (Maybe DeployedVersionSummary)
getApplicationResponse_deployedVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe DeployedVersionSummary
deployedVersion :: Maybe DeployedVersionSummary
$sel:deployedVersion:GetApplicationResponse' :: GetApplicationResponse -> Maybe DeployedVersionSummary
deployedVersion} -> Maybe DeployedVersionSummary
deployedVersion) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe DeployedVersionSummary
a -> GetApplicationResponse
s {$sel:deployedVersion:GetApplicationResponse' :: Maybe DeployedVersionSummary
deployedVersion = Maybe DeployedVersionSummary
a} :: GetApplicationResponse)

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

-- | The identifier of the runtime environment where you want to deploy the
-- application.
getApplicationResponse_environmentId :: Lens.Lens' GetApplicationResponse (Prelude.Maybe Prelude.Text)
getApplicationResponse_environmentId :: Lens' GetApplicationResponse (Maybe Text)
getApplicationResponse_environmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe Text
environmentId :: Maybe Text
$sel:environmentId:GetApplicationResponse' :: GetApplicationResponse -> Maybe Text
environmentId} -> Maybe Text
environmentId) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe Text
a -> GetApplicationResponse
s {$sel:environmentId:GetApplicationResponse' :: Maybe Text
environmentId = Maybe Text
a} :: GetApplicationResponse)

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

-- | The timestamp when you last started the application. Null until the
-- application runs for the first time.
getApplicationResponse_lastStartTime :: Lens.Lens' GetApplicationResponse (Prelude.Maybe Prelude.UTCTime)
getApplicationResponse_lastStartTime :: Lens' GetApplicationResponse (Maybe UTCTime)
getApplicationResponse_lastStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe POSIX
lastStartTime :: Maybe POSIX
$sel:lastStartTime:GetApplicationResponse' :: GetApplicationResponse -> Maybe POSIX
lastStartTime} -> Maybe POSIX
lastStartTime) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe POSIX
a -> GetApplicationResponse
s {$sel:lastStartTime:GetApplicationResponse' :: Maybe POSIX
lastStartTime = Maybe POSIX
a} :: GetApplicationResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The Amazon Resource Name (ARN) for the network load balancer listener
-- created in your Amazon Web Services account. Amazon Web Services
-- Mainframe Modernization creates this listener for you the first time you
-- deploy an application.
getApplicationResponse_listenerArns :: Lens.Lens' GetApplicationResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
getApplicationResponse_listenerArns :: Lens' GetApplicationResponse (Maybe (NonEmpty Text))
getApplicationResponse_listenerArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe (NonEmpty Text)
listenerArns :: Maybe (NonEmpty Text)
$sel:listenerArns:GetApplicationResponse' :: GetApplicationResponse -> Maybe (NonEmpty Text)
listenerArns} -> Maybe (NonEmpty Text)
listenerArns) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe (NonEmpty Text)
a -> GetApplicationResponse
s {$sel:listenerArns:GetApplicationResponse' :: Maybe (NonEmpty Text)
listenerArns = Maybe (NonEmpty Text)
a} :: GetApplicationResponse) 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 port associated with the network load balancer listener created in
-- your Amazon Web Services account.
getApplicationResponse_listenerPorts :: Lens.Lens' GetApplicationResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Int))
getApplicationResponse_listenerPorts :: Lens' GetApplicationResponse (Maybe (NonEmpty Int))
getApplicationResponse_listenerPorts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe (NonEmpty Int)
listenerPorts :: Maybe (NonEmpty Int)
$sel:listenerPorts:GetApplicationResponse' :: GetApplicationResponse -> Maybe (NonEmpty Int)
listenerPorts} -> Maybe (NonEmpty Int)
listenerPorts) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe (NonEmpty Int)
a -> GetApplicationResponse
s {$sel:listenerPorts:GetApplicationResponse' :: Maybe (NonEmpty Int)
listenerPorts = Maybe (NonEmpty Int)
a} :: GetApplicationResponse) 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 public DNS name of the load balancer created in your Amazon Web
-- Services account.
getApplicationResponse_loadBalancerDnsName :: Lens.Lens' GetApplicationResponse (Prelude.Maybe Prelude.Text)
getApplicationResponse_loadBalancerDnsName :: Lens' GetApplicationResponse (Maybe Text)
getApplicationResponse_loadBalancerDnsName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe Text
loadBalancerDnsName :: Maybe Text
$sel:loadBalancerDnsName:GetApplicationResponse' :: GetApplicationResponse -> Maybe Text
loadBalancerDnsName} -> Maybe Text
loadBalancerDnsName) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe Text
a -> GetApplicationResponse
s {$sel:loadBalancerDnsName:GetApplicationResponse' :: Maybe Text
loadBalancerDnsName = Maybe Text
a} :: GetApplicationResponse)

-- | The list of log summaries. Each log summary includes the log type as
-- well as the log group identifier. These are CloudWatch logs. Amazon Web
-- Services Mainframe Modernization pushes the application log to
-- CloudWatch under the customer\'s account.
getApplicationResponse_logGroups :: Lens.Lens' GetApplicationResponse (Prelude.Maybe [LogGroupSummary])
getApplicationResponse_logGroups :: Lens' GetApplicationResponse (Maybe [LogGroupSummary])
getApplicationResponse_logGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe [LogGroupSummary]
logGroups :: Maybe [LogGroupSummary]
$sel:logGroups:GetApplicationResponse' :: GetApplicationResponse -> Maybe [LogGroupSummary]
logGroups} -> Maybe [LogGroupSummary]
logGroups) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe [LogGroupSummary]
a -> GetApplicationResponse
s {$sel:logGroups:GetApplicationResponse' :: Maybe [LogGroupSummary]
logGroups = Maybe [LogGroupSummary]
a} :: GetApplicationResponse) 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 reason for the reported status.
getApplicationResponse_statusReason :: Lens.Lens' GetApplicationResponse (Prelude.Maybe Prelude.Text)
getApplicationResponse_statusReason :: Lens' GetApplicationResponse (Maybe Text)
getApplicationResponse_statusReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe Text
statusReason :: Maybe Text
$sel:statusReason:GetApplicationResponse' :: GetApplicationResponse -> Maybe Text
statusReason} -> Maybe Text
statusReason) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe Text
a -> GetApplicationResponse
s {$sel:statusReason:GetApplicationResponse' :: Maybe Text
statusReason = Maybe Text
a} :: GetApplicationResponse)

-- | A list of tags associated with the application.
getApplicationResponse_tags :: Lens.Lens' GetApplicationResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getApplicationResponse_tags :: Lens' GetApplicationResponse (Maybe (HashMap Text Text))
getApplicationResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetApplicationResponse' :: GetApplicationResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe (HashMap Text Text)
a -> GetApplicationResponse
s {$sel:tags:GetApplicationResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetApplicationResponse) 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

-- | Returns the Amazon Resource Names (ARNs) of the target groups that are
-- attached to the network load balancer.
getApplicationResponse_targetGroupArns :: Lens.Lens' GetApplicationResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
getApplicationResponse_targetGroupArns :: Lens' GetApplicationResponse (Maybe (NonEmpty Text))
getApplicationResponse_targetGroupArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Maybe (NonEmpty Text)
targetGroupArns :: Maybe (NonEmpty Text)
$sel:targetGroupArns:GetApplicationResponse' :: GetApplicationResponse -> Maybe (NonEmpty Text)
targetGroupArns} -> Maybe (NonEmpty Text)
targetGroupArns) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Maybe (NonEmpty Text)
a -> GetApplicationResponse
s {$sel:targetGroupArns:GetApplicationResponse' :: Maybe (NonEmpty Text)
targetGroupArns = Maybe (NonEmpty Text)
a} :: GetApplicationResponse) 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.
getApplicationResponse_httpStatus :: Lens.Lens' GetApplicationResponse Prelude.Int
getApplicationResponse_httpStatus :: Lens' GetApplicationResponse Int
getApplicationResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetApplicationResponse' :: GetApplicationResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Int
a -> GetApplicationResponse
s {$sel:httpStatus:GetApplicationResponse' :: Int
httpStatus = Int
a} :: GetApplicationResponse)

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

-- | The identifier of the application.
getApplicationResponse_applicationId :: Lens.Lens' GetApplicationResponse Prelude.Text
getApplicationResponse_applicationId :: Lens' GetApplicationResponse Text
getApplicationResponse_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Text
applicationId :: Text
$sel:applicationId:GetApplicationResponse' :: GetApplicationResponse -> Text
applicationId} -> Text
applicationId) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Text
a -> GetApplicationResponse
s {$sel:applicationId:GetApplicationResponse' :: Text
applicationId = Text
a} :: GetApplicationResponse)

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

-- | The type of the target platform for the application.
getApplicationResponse_engineType :: Lens.Lens' GetApplicationResponse EngineType
getApplicationResponse_engineType :: Lens' GetApplicationResponse EngineType
getApplicationResponse_engineType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {EngineType
engineType :: EngineType
$sel:engineType:GetApplicationResponse' :: GetApplicationResponse -> EngineType
engineType} -> EngineType
engineType) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} EngineType
a -> GetApplicationResponse
s {$sel:engineType:GetApplicationResponse' :: EngineType
engineType = EngineType
a} :: GetApplicationResponse)

-- | The latest version of the application.
getApplicationResponse_latestVersion :: Lens.Lens' GetApplicationResponse ApplicationVersionSummary
getApplicationResponse_latestVersion :: Lens' GetApplicationResponse ApplicationVersionSummary
getApplicationResponse_latestVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {ApplicationVersionSummary
latestVersion :: ApplicationVersionSummary
$sel:latestVersion:GetApplicationResponse' :: GetApplicationResponse -> ApplicationVersionSummary
latestVersion} -> ApplicationVersionSummary
latestVersion) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} ApplicationVersionSummary
a -> GetApplicationResponse
s {$sel:latestVersion:GetApplicationResponse' :: ApplicationVersionSummary
latestVersion = ApplicationVersionSummary
a} :: GetApplicationResponse)

-- | The unique identifier of the application.
getApplicationResponse_name :: Lens.Lens' GetApplicationResponse Prelude.Text
getApplicationResponse_name :: Lens' GetApplicationResponse Text
getApplicationResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {Text
name :: Text
$sel:name:GetApplicationResponse' :: GetApplicationResponse -> Text
name} -> Text
name) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} Text
a -> GetApplicationResponse
s {$sel:name:GetApplicationResponse' :: Text
name = Text
a} :: GetApplicationResponse)

-- | The status of the application.
getApplicationResponse_status :: Lens.Lens' GetApplicationResponse ApplicationLifecycle
getApplicationResponse_status :: Lens' GetApplicationResponse ApplicationLifecycle
getApplicationResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApplicationResponse' {ApplicationLifecycle
status :: ApplicationLifecycle
$sel:status:GetApplicationResponse' :: GetApplicationResponse -> ApplicationLifecycle
status} -> ApplicationLifecycle
status) (\s :: GetApplicationResponse
s@GetApplicationResponse' {} ApplicationLifecycle
a -> GetApplicationResponse
s {$sel:status:GetApplicationResponse' :: ApplicationLifecycle
status = ApplicationLifecycle
a} :: GetApplicationResponse)

instance Prelude.NFData GetApplicationResponse where
  rnf :: GetApplicationResponse -> ()
rnf GetApplicationResponse' {Int
Maybe [LogGroupSummary]
Maybe (NonEmpty Int)
Maybe (NonEmpty Text)
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe DeployedVersionSummary
Text
POSIX
ApplicationLifecycle
ApplicationVersionSummary
EngineType
status :: ApplicationLifecycle
name :: Text
latestVersion :: ApplicationVersionSummary
engineType :: EngineType
creationTime :: POSIX
applicationId :: Text
applicationArn :: Text
httpStatus :: Int
targetGroupArns :: Maybe (NonEmpty Text)
tags :: Maybe (HashMap Text Text)
statusReason :: Maybe Text
logGroups :: Maybe [LogGroupSummary]
loadBalancerDnsName :: Maybe Text
listenerPorts :: Maybe (NonEmpty Int)
listenerArns :: Maybe (NonEmpty Text)
lastStartTime :: Maybe POSIX
kmsKeyId :: Maybe Text
environmentId :: Maybe Text
description :: Maybe Text
deployedVersion :: Maybe DeployedVersionSummary
$sel:status:GetApplicationResponse' :: GetApplicationResponse -> ApplicationLifecycle
$sel:name:GetApplicationResponse' :: GetApplicationResponse -> Text
$sel:latestVersion:GetApplicationResponse' :: GetApplicationResponse -> ApplicationVersionSummary
$sel:engineType:GetApplicationResponse' :: GetApplicationResponse -> EngineType
$sel:creationTime:GetApplicationResponse' :: GetApplicationResponse -> POSIX
$sel:applicationId:GetApplicationResponse' :: GetApplicationResponse -> Text
$sel:applicationArn:GetApplicationResponse' :: GetApplicationResponse -> Text
$sel:httpStatus:GetApplicationResponse' :: GetApplicationResponse -> Int
$sel:targetGroupArns:GetApplicationResponse' :: GetApplicationResponse -> Maybe (NonEmpty Text)
$sel:tags:GetApplicationResponse' :: GetApplicationResponse -> Maybe (HashMap Text Text)
$sel:statusReason:GetApplicationResponse' :: GetApplicationResponse -> Maybe Text
$sel:logGroups:GetApplicationResponse' :: GetApplicationResponse -> Maybe [LogGroupSummary]
$sel:loadBalancerDnsName:GetApplicationResponse' :: GetApplicationResponse -> Maybe Text
$sel:listenerPorts:GetApplicationResponse' :: GetApplicationResponse -> Maybe (NonEmpty Int)
$sel:listenerArns:GetApplicationResponse' :: GetApplicationResponse -> Maybe (NonEmpty Text)
$sel:lastStartTime:GetApplicationResponse' :: GetApplicationResponse -> Maybe POSIX
$sel:kmsKeyId:GetApplicationResponse' :: GetApplicationResponse -> Maybe Text
$sel:environmentId:GetApplicationResponse' :: GetApplicationResponse -> Maybe Text
$sel:description:GetApplicationResponse' :: GetApplicationResponse -> Maybe Text
$sel:deployedVersion:GetApplicationResponse' :: GetApplicationResponse -> Maybe DeployedVersionSummary
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DeployedVersionSummary
deployedVersion
      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 Text
environmentId
      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 POSIX
lastStartTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
listenerArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Int)
listenerPorts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
loadBalancerDnsName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [LogGroupSummary]
logGroups
      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 (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
targetGroupArns
      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 Text
applicationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf 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 ApplicationVersionSummary
latestVersion
      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 ApplicationLifecycle
status