{-# 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.MigrationHubReFactorSpaces.DeleteApplication
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes an Amazon Web Services Migration Hub Refactor Spaces
-- application. Before you can delete an application, you must first delete
-- any services or routes within the application.
module Amazonka.MigrationHubReFactorSpaces.DeleteApplication
  ( -- * Creating a Request
    DeleteApplication (..),
    newDeleteApplication,

    -- * Request Lenses
    deleteApplication_applicationIdentifier,
    deleteApplication_environmentIdentifier,

    -- * Destructuring the Response
    DeleteApplicationResponse (..),
    newDeleteApplicationResponse,

    -- * Response Lenses
    deleteApplicationResponse_applicationId,
    deleteApplicationResponse_arn,
    deleteApplicationResponse_environmentId,
    deleteApplicationResponse_lastUpdatedTime,
    deleteApplicationResponse_name,
    deleteApplicationResponse_state,
    deleteApplicationResponse_httpStatus,
  )
where

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

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

-- |
-- Create a value of 'DeleteApplication' 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:
--
-- 'applicationIdentifier', 'deleteApplication_applicationIdentifier' - The ID of the application.
--
-- 'environmentIdentifier', 'deleteApplication_environmentIdentifier' - The ID of the environment.
newDeleteApplication ::
  -- | 'applicationIdentifier'
  Prelude.Text ->
  -- | 'environmentIdentifier'
  Prelude.Text ->
  DeleteApplication
newDeleteApplication :: Text -> Text -> DeleteApplication
newDeleteApplication
  Text
pApplicationIdentifier_
  Text
pEnvironmentIdentifier_ =
    DeleteApplication'
      { $sel:applicationIdentifier:DeleteApplication' :: Text
applicationIdentifier =
          Text
pApplicationIdentifier_,
        $sel:environmentIdentifier:DeleteApplication' :: Text
environmentIdentifier = Text
pEnvironmentIdentifier_
      }

-- | The ID of the application.
deleteApplication_applicationIdentifier :: Lens.Lens' DeleteApplication Prelude.Text
deleteApplication_applicationIdentifier :: Lens' DeleteApplication Text
deleteApplication_applicationIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteApplication' {Text
applicationIdentifier :: Text
$sel:applicationIdentifier:DeleteApplication' :: DeleteApplication -> Text
applicationIdentifier} -> Text
applicationIdentifier) (\s :: DeleteApplication
s@DeleteApplication' {} Text
a -> DeleteApplication
s {$sel:applicationIdentifier:DeleteApplication' :: Text
applicationIdentifier = Text
a} :: DeleteApplication)

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

instance Core.AWSRequest DeleteApplication where
  type
    AWSResponse DeleteApplication =
      DeleteApplicationResponse
  request :: (Service -> Service)
-> DeleteApplication -> Request DeleteApplication
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteApplication
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteApplication)))
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 Text
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe ApplicationState
-> Int
-> DeleteApplicationResponse
DeleteApplicationResponse'
            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
"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 (Maybe a)
Data..?> Key
"Arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> 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
"LastUpdatedTime")
            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
"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
"State")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

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

instance Prelude.NFData DeleteApplication where
  rnf :: DeleteApplication -> ()
rnf DeleteApplication' {Text
environmentIdentifier :: Text
applicationIdentifier :: Text
$sel:environmentIdentifier:DeleteApplication' :: DeleteApplication -> Text
$sel:applicationIdentifier:DeleteApplication' :: DeleteApplication -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
applicationIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
environmentIdentifier

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

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

-- | /See:/ 'newDeleteApplicationResponse' smart constructor.
data DeleteApplicationResponse = DeleteApplicationResponse'
  { -- | The ID of the application.
    DeleteApplicationResponse -> Maybe Text
applicationId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the application.
    DeleteApplicationResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the application’s environment.
    DeleteApplicationResponse -> Maybe Text
environmentId :: Prelude.Maybe Prelude.Text,
    -- | A timestamp that indicates when the environment was last updated.
    DeleteApplicationResponse -> Maybe POSIX
lastUpdatedTime :: Prelude.Maybe Data.POSIX,
    -- | The name of the application.
    DeleteApplicationResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The current state of the application.
    DeleteApplicationResponse -> Maybe ApplicationState
state :: Prelude.Maybe ApplicationState,
    -- | The response's http status code.
    DeleteApplicationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteApplicationResponse -> DeleteApplicationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteApplicationResponse -> DeleteApplicationResponse -> Bool
$c/= :: DeleteApplicationResponse -> DeleteApplicationResponse -> Bool
== :: DeleteApplicationResponse -> DeleteApplicationResponse -> Bool
$c== :: DeleteApplicationResponse -> DeleteApplicationResponse -> Bool
Prelude.Eq, ReadPrec [DeleteApplicationResponse]
ReadPrec DeleteApplicationResponse
Int -> ReadS DeleteApplicationResponse
ReadS [DeleteApplicationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteApplicationResponse]
$creadListPrec :: ReadPrec [DeleteApplicationResponse]
readPrec :: ReadPrec DeleteApplicationResponse
$creadPrec :: ReadPrec DeleteApplicationResponse
readList :: ReadS [DeleteApplicationResponse]
$creadList :: ReadS [DeleteApplicationResponse]
readsPrec :: Int -> ReadS DeleteApplicationResponse
$creadsPrec :: Int -> ReadS DeleteApplicationResponse
Prelude.Read, Int -> DeleteApplicationResponse -> ShowS
[DeleteApplicationResponse] -> ShowS
DeleteApplicationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteApplicationResponse] -> ShowS
$cshowList :: [DeleteApplicationResponse] -> ShowS
show :: DeleteApplicationResponse -> String
$cshow :: DeleteApplicationResponse -> String
showsPrec :: Int -> DeleteApplicationResponse -> ShowS
$cshowsPrec :: Int -> DeleteApplicationResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteApplicationResponse x -> DeleteApplicationResponse
forall x.
DeleteApplicationResponse -> Rep DeleteApplicationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteApplicationResponse x -> DeleteApplicationResponse
$cfrom :: forall x.
DeleteApplicationResponse -> Rep DeleteApplicationResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteApplicationResponse' 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', 'deleteApplicationResponse_applicationId' - The ID of the application.
--
-- 'arn', 'deleteApplicationResponse_arn' - The Amazon Resource Name (ARN) of the application.
--
-- 'environmentId', 'deleteApplicationResponse_environmentId' - The unique identifier of the application’s environment.
--
-- 'lastUpdatedTime', 'deleteApplicationResponse_lastUpdatedTime' - A timestamp that indicates when the environment was last updated.
--
-- 'name', 'deleteApplicationResponse_name' - The name of the application.
--
-- 'state', 'deleteApplicationResponse_state' - The current state of the application.
--
-- 'httpStatus', 'deleteApplicationResponse_httpStatus' - The response's http status code.
newDeleteApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteApplicationResponse
newDeleteApplicationResponse :: Int -> DeleteApplicationResponse
newDeleteApplicationResponse Int
pHttpStatus_ =
  DeleteApplicationResponse'
    { $sel:applicationId:DeleteApplicationResponse' :: Maybe Text
applicationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:arn:DeleteApplicationResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:environmentId:DeleteApplicationResponse' :: Maybe Text
environmentId = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedTime:DeleteApplicationResponse' :: Maybe POSIX
lastUpdatedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DeleteApplicationResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:state:DeleteApplicationResponse' :: Maybe ApplicationState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteApplicationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

-- | The unique identifier of the application’s environment.
deleteApplicationResponse_environmentId :: Lens.Lens' DeleteApplicationResponse (Prelude.Maybe Prelude.Text)
deleteApplicationResponse_environmentId :: Lens' DeleteApplicationResponse (Maybe Text)
deleteApplicationResponse_environmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteApplicationResponse' {Maybe Text
environmentId :: Maybe Text
$sel:environmentId:DeleteApplicationResponse' :: DeleteApplicationResponse -> Maybe Text
environmentId} -> Maybe Text
environmentId) (\s :: DeleteApplicationResponse
s@DeleteApplicationResponse' {} Maybe Text
a -> DeleteApplicationResponse
s {$sel:environmentId:DeleteApplicationResponse' :: Maybe Text
environmentId = Maybe Text
a} :: DeleteApplicationResponse)

-- | A timestamp that indicates when the environment was last updated.
deleteApplicationResponse_lastUpdatedTime :: Lens.Lens' DeleteApplicationResponse (Prelude.Maybe Prelude.UTCTime)
deleteApplicationResponse_lastUpdatedTime :: Lens' DeleteApplicationResponse (Maybe UTCTime)
deleteApplicationResponse_lastUpdatedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteApplicationResponse' {Maybe POSIX
lastUpdatedTime :: Maybe POSIX
$sel:lastUpdatedTime:DeleteApplicationResponse' :: DeleteApplicationResponse -> Maybe POSIX
lastUpdatedTime} -> Maybe POSIX
lastUpdatedTime) (\s :: DeleteApplicationResponse
s@DeleteApplicationResponse' {} Maybe POSIX
a -> DeleteApplicationResponse
s {$sel:lastUpdatedTime:DeleteApplicationResponse' :: Maybe POSIX
lastUpdatedTime = Maybe POSIX
a} :: DeleteApplicationResponse) 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 name of the application.
deleteApplicationResponse_name :: Lens.Lens' DeleteApplicationResponse (Prelude.Maybe Prelude.Text)
deleteApplicationResponse_name :: Lens' DeleteApplicationResponse (Maybe Text)
deleteApplicationResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteApplicationResponse' {Maybe Text
name :: Maybe Text
$sel:name:DeleteApplicationResponse' :: DeleteApplicationResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: DeleteApplicationResponse
s@DeleteApplicationResponse' {} Maybe Text
a -> DeleteApplicationResponse
s {$sel:name:DeleteApplicationResponse' :: Maybe Text
name = Maybe Text
a} :: DeleteApplicationResponse)

-- | The current state of the application.
deleteApplicationResponse_state :: Lens.Lens' DeleteApplicationResponse (Prelude.Maybe ApplicationState)
deleteApplicationResponse_state :: Lens' DeleteApplicationResponse (Maybe ApplicationState)
deleteApplicationResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteApplicationResponse' {Maybe ApplicationState
state :: Maybe ApplicationState
$sel:state:DeleteApplicationResponse' :: DeleteApplicationResponse -> Maybe ApplicationState
state} -> Maybe ApplicationState
state) (\s :: DeleteApplicationResponse
s@DeleteApplicationResponse' {} Maybe ApplicationState
a -> DeleteApplicationResponse
s {$sel:state:DeleteApplicationResponse' :: Maybe ApplicationState
state = Maybe ApplicationState
a} :: DeleteApplicationResponse)

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

instance Prelude.NFData DeleteApplicationResponse where
  rnf :: DeleteApplicationResponse -> ()
rnf DeleteApplicationResponse' {Int
Maybe Text
Maybe POSIX
Maybe ApplicationState
httpStatus :: Int
state :: Maybe ApplicationState
name :: Maybe Text
lastUpdatedTime :: Maybe POSIX
environmentId :: Maybe Text
arn :: Maybe Text
applicationId :: Maybe Text
$sel:httpStatus:DeleteApplicationResponse' :: DeleteApplicationResponse -> Int
$sel:state:DeleteApplicationResponse' :: DeleteApplicationResponse -> Maybe ApplicationState
$sel:name:DeleteApplicationResponse' :: DeleteApplicationResponse -> Maybe Text
$sel:lastUpdatedTime:DeleteApplicationResponse' :: DeleteApplicationResponse -> Maybe POSIX
$sel:environmentId:DeleteApplicationResponse' :: DeleteApplicationResponse -> Maybe Text
$sel:arn:DeleteApplicationResponse' :: DeleteApplicationResponse -> Maybe Text
$sel:applicationId:DeleteApplicationResponse' :: DeleteApplicationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      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 POSIX
lastUpdatedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ApplicationState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus