{-# 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.ApplicationInsights.UpdateApplication
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the application.
module Amazonka.ApplicationInsights.UpdateApplication
  ( -- * Creating a Request
    UpdateApplication (..),
    newUpdateApplication,

    -- * Request Lenses
    updateApplication_autoConfigEnabled,
    updateApplication_cWEMonitorEnabled,
    updateApplication_opsCenterEnabled,
    updateApplication_opsItemSNSTopicArn,
    updateApplication_removeSNSTopic,
    updateApplication_resourceGroupName,

    -- * Destructuring the Response
    UpdateApplicationResponse (..),
    newUpdateApplicationResponse,

    -- * Response Lenses
    updateApplicationResponse_applicationInfo,
    updateApplicationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateApplication' smart constructor.
data UpdateApplication = UpdateApplication'
  { -- | Turns auto-configuration on or off.
    UpdateApplication -> Maybe Bool
autoConfigEnabled :: Prelude.Maybe Prelude.Bool,
    -- | Indicates whether Application Insights can listen to CloudWatch events
    -- for the application resources, such as @instance terminated@,
    -- @failed deployment@, and others.
    UpdateApplication -> Maybe Bool
cWEMonitorEnabled :: Prelude.Maybe Prelude.Bool,
    -- | When set to @true@, creates opsItems for any problems detected on an
    -- application.
    UpdateApplication -> Maybe Bool
opsCenterEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The SNS topic provided to Application Insights that is associated to the
    -- created opsItem. Allows you to receive notifications for updates to the
    -- opsItem.
    UpdateApplication -> Maybe Text
opsItemSNSTopicArn :: Prelude.Maybe Prelude.Text,
    -- | Disassociates the SNS topic from the opsItem created for detected
    -- problems.
    UpdateApplication -> Maybe Bool
removeSNSTopic :: Prelude.Maybe Prelude.Bool,
    -- | The name of the resource group.
    UpdateApplication -> Text
resourceGroupName :: Prelude.Text
  }
  deriving (UpdateApplication -> UpdateApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateApplication -> UpdateApplication -> Bool
$c/= :: UpdateApplication -> UpdateApplication -> Bool
== :: UpdateApplication -> UpdateApplication -> Bool
$c== :: UpdateApplication -> UpdateApplication -> Bool
Prelude.Eq, ReadPrec [UpdateApplication]
ReadPrec UpdateApplication
Int -> ReadS UpdateApplication
ReadS [UpdateApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateApplication]
$creadListPrec :: ReadPrec [UpdateApplication]
readPrec :: ReadPrec UpdateApplication
$creadPrec :: ReadPrec UpdateApplication
readList :: ReadS [UpdateApplication]
$creadList :: ReadS [UpdateApplication]
readsPrec :: Int -> ReadS UpdateApplication
$creadsPrec :: Int -> ReadS UpdateApplication
Prelude.Read, Int -> UpdateApplication -> ShowS
[UpdateApplication] -> ShowS
UpdateApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateApplication] -> ShowS
$cshowList :: [UpdateApplication] -> ShowS
show :: UpdateApplication -> String
$cshow :: UpdateApplication -> String
showsPrec :: Int -> UpdateApplication -> ShowS
$cshowsPrec :: Int -> UpdateApplication -> ShowS
Prelude.Show, forall x. Rep UpdateApplication x -> UpdateApplication
forall x. UpdateApplication -> Rep UpdateApplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateApplication x -> UpdateApplication
$cfrom :: forall x. UpdateApplication -> Rep UpdateApplication x
Prelude.Generic)

-- |
-- Create a value of 'UpdateApplication' 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:
--
-- 'autoConfigEnabled', 'updateApplication_autoConfigEnabled' - Turns auto-configuration on or off.
--
-- 'cWEMonitorEnabled', 'updateApplication_cWEMonitorEnabled' - Indicates whether Application Insights can listen to CloudWatch events
-- for the application resources, such as @instance terminated@,
-- @failed deployment@, and others.
--
-- 'opsCenterEnabled', 'updateApplication_opsCenterEnabled' - When set to @true@, creates opsItems for any problems detected on an
-- application.
--
-- 'opsItemSNSTopicArn', 'updateApplication_opsItemSNSTopicArn' - The SNS topic provided to Application Insights that is associated to the
-- created opsItem. Allows you to receive notifications for updates to the
-- opsItem.
--
-- 'removeSNSTopic', 'updateApplication_removeSNSTopic' - Disassociates the SNS topic from the opsItem created for detected
-- problems.
--
-- 'resourceGroupName', 'updateApplication_resourceGroupName' - The name of the resource group.
newUpdateApplication ::
  -- | 'resourceGroupName'
  Prelude.Text ->
  UpdateApplication
newUpdateApplication :: Text -> UpdateApplication
newUpdateApplication Text
pResourceGroupName_ =
  UpdateApplication'
    { $sel:autoConfigEnabled:UpdateApplication' :: Maybe Bool
autoConfigEnabled =
        forall a. Maybe a
Prelude.Nothing,
      $sel:cWEMonitorEnabled:UpdateApplication' :: Maybe Bool
cWEMonitorEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:opsCenterEnabled:UpdateApplication' :: Maybe Bool
opsCenterEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:opsItemSNSTopicArn:UpdateApplication' :: Maybe Text
opsItemSNSTopicArn = forall a. Maybe a
Prelude.Nothing,
      $sel:removeSNSTopic:UpdateApplication' :: Maybe Bool
removeSNSTopic = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceGroupName:UpdateApplication' :: Text
resourceGroupName = Text
pResourceGroupName_
    }

-- | Turns auto-configuration on or off.
updateApplication_autoConfigEnabled :: Lens.Lens' UpdateApplication (Prelude.Maybe Prelude.Bool)
updateApplication_autoConfigEnabled :: Lens' UpdateApplication (Maybe Bool)
updateApplication_autoConfigEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplication' {Maybe Bool
autoConfigEnabled :: Maybe Bool
$sel:autoConfigEnabled:UpdateApplication' :: UpdateApplication -> Maybe Bool
autoConfigEnabled} -> Maybe Bool
autoConfigEnabled) (\s :: UpdateApplication
s@UpdateApplication' {} Maybe Bool
a -> UpdateApplication
s {$sel:autoConfigEnabled:UpdateApplication' :: Maybe Bool
autoConfigEnabled = Maybe Bool
a} :: UpdateApplication)

-- | Indicates whether Application Insights can listen to CloudWatch events
-- for the application resources, such as @instance terminated@,
-- @failed deployment@, and others.
updateApplication_cWEMonitorEnabled :: Lens.Lens' UpdateApplication (Prelude.Maybe Prelude.Bool)
updateApplication_cWEMonitorEnabled :: Lens' UpdateApplication (Maybe Bool)
updateApplication_cWEMonitorEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplication' {Maybe Bool
cWEMonitorEnabled :: Maybe Bool
$sel:cWEMonitorEnabled:UpdateApplication' :: UpdateApplication -> Maybe Bool
cWEMonitorEnabled} -> Maybe Bool
cWEMonitorEnabled) (\s :: UpdateApplication
s@UpdateApplication' {} Maybe Bool
a -> UpdateApplication
s {$sel:cWEMonitorEnabled:UpdateApplication' :: Maybe Bool
cWEMonitorEnabled = Maybe Bool
a} :: UpdateApplication)

-- | When set to @true@, creates opsItems for any problems detected on an
-- application.
updateApplication_opsCenterEnabled :: Lens.Lens' UpdateApplication (Prelude.Maybe Prelude.Bool)
updateApplication_opsCenterEnabled :: Lens' UpdateApplication (Maybe Bool)
updateApplication_opsCenterEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplication' {Maybe Bool
opsCenterEnabled :: Maybe Bool
$sel:opsCenterEnabled:UpdateApplication' :: UpdateApplication -> Maybe Bool
opsCenterEnabled} -> Maybe Bool
opsCenterEnabled) (\s :: UpdateApplication
s@UpdateApplication' {} Maybe Bool
a -> UpdateApplication
s {$sel:opsCenterEnabled:UpdateApplication' :: Maybe Bool
opsCenterEnabled = Maybe Bool
a} :: UpdateApplication)

-- | The SNS topic provided to Application Insights that is associated to the
-- created opsItem. Allows you to receive notifications for updates to the
-- opsItem.
updateApplication_opsItemSNSTopicArn :: Lens.Lens' UpdateApplication (Prelude.Maybe Prelude.Text)
updateApplication_opsItemSNSTopicArn :: Lens' UpdateApplication (Maybe Text)
updateApplication_opsItemSNSTopicArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplication' {Maybe Text
opsItemSNSTopicArn :: Maybe Text
$sel:opsItemSNSTopicArn:UpdateApplication' :: UpdateApplication -> Maybe Text
opsItemSNSTopicArn} -> Maybe Text
opsItemSNSTopicArn) (\s :: UpdateApplication
s@UpdateApplication' {} Maybe Text
a -> UpdateApplication
s {$sel:opsItemSNSTopicArn:UpdateApplication' :: Maybe Text
opsItemSNSTopicArn = Maybe Text
a} :: UpdateApplication)

-- | Disassociates the SNS topic from the opsItem created for detected
-- problems.
updateApplication_removeSNSTopic :: Lens.Lens' UpdateApplication (Prelude.Maybe Prelude.Bool)
updateApplication_removeSNSTopic :: Lens' UpdateApplication (Maybe Bool)
updateApplication_removeSNSTopic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplication' {Maybe Bool
removeSNSTopic :: Maybe Bool
$sel:removeSNSTopic:UpdateApplication' :: UpdateApplication -> Maybe Bool
removeSNSTopic} -> Maybe Bool
removeSNSTopic) (\s :: UpdateApplication
s@UpdateApplication' {} Maybe Bool
a -> UpdateApplication
s {$sel:removeSNSTopic:UpdateApplication' :: Maybe Bool
removeSNSTopic = Maybe Bool
a} :: UpdateApplication)

-- | The name of the resource group.
updateApplication_resourceGroupName :: Lens.Lens' UpdateApplication Prelude.Text
updateApplication_resourceGroupName :: Lens' UpdateApplication Text
updateApplication_resourceGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplication' {Text
resourceGroupName :: Text
$sel:resourceGroupName:UpdateApplication' :: UpdateApplication -> Text
resourceGroupName} -> Text
resourceGroupName) (\s :: UpdateApplication
s@UpdateApplication' {} Text
a -> UpdateApplication
s {$sel:resourceGroupName:UpdateApplication' :: Text
resourceGroupName = Text
a} :: UpdateApplication)

instance Core.AWSRequest UpdateApplication where
  type
    AWSResponse UpdateApplication =
      UpdateApplicationResponse
  request :: (Service -> Service)
-> UpdateApplication -> Request UpdateApplication
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateApplication
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateApplication)))
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 ApplicationInfo -> Int -> UpdateApplicationResponse
UpdateApplicationResponse'
            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
"ApplicationInfo")
            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 UpdateApplication where
  hashWithSalt :: Int -> UpdateApplication -> Int
hashWithSalt Int
_salt UpdateApplication' {Maybe Bool
Maybe Text
Text
resourceGroupName :: Text
removeSNSTopic :: Maybe Bool
opsItemSNSTopicArn :: Maybe Text
opsCenterEnabled :: Maybe Bool
cWEMonitorEnabled :: Maybe Bool
autoConfigEnabled :: Maybe Bool
$sel:resourceGroupName:UpdateApplication' :: UpdateApplication -> Text
$sel:removeSNSTopic:UpdateApplication' :: UpdateApplication -> Maybe Bool
$sel:opsItemSNSTopicArn:UpdateApplication' :: UpdateApplication -> Maybe Text
$sel:opsCenterEnabled:UpdateApplication' :: UpdateApplication -> Maybe Bool
$sel:cWEMonitorEnabled:UpdateApplication' :: UpdateApplication -> Maybe Bool
$sel:autoConfigEnabled:UpdateApplication' :: UpdateApplication -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoConfigEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
cWEMonitorEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
opsCenterEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
opsItemSNSTopicArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
removeSNSTopic
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceGroupName

instance Prelude.NFData UpdateApplication where
  rnf :: UpdateApplication -> ()
rnf UpdateApplication' {Maybe Bool
Maybe Text
Text
resourceGroupName :: Text
removeSNSTopic :: Maybe Bool
opsItemSNSTopicArn :: Maybe Text
opsCenterEnabled :: Maybe Bool
cWEMonitorEnabled :: Maybe Bool
autoConfigEnabled :: Maybe Bool
$sel:resourceGroupName:UpdateApplication' :: UpdateApplication -> Text
$sel:removeSNSTopic:UpdateApplication' :: UpdateApplication -> Maybe Bool
$sel:opsItemSNSTopicArn:UpdateApplication' :: UpdateApplication -> Maybe Text
$sel:opsCenterEnabled:UpdateApplication' :: UpdateApplication -> Maybe Bool
$sel:cWEMonitorEnabled:UpdateApplication' :: UpdateApplication -> Maybe Bool
$sel:autoConfigEnabled:UpdateApplication' :: UpdateApplication -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoConfigEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
cWEMonitorEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
opsCenterEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
opsItemSNSTopicArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
removeSNSTopic
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceGroupName

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

instance Data.ToJSON UpdateApplication where
  toJSON :: UpdateApplication -> Value
toJSON UpdateApplication' {Maybe Bool
Maybe Text
Text
resourceGroupName :: Text
removeSNSTopic :: Maybe Bool
opsItemSNSTopicArn :: Maybe Text
opsCenterEnabled :: Maybe Bool
cWEMonitorEnabled :: Maybe Bool
autoConfigEnabled :: Maybe Bool
$sel:resourceGroupName:UpdateApplication' :: UpdateApplication -> Text
$sel:removeSNSTopic:UpdateApplication' :: UpdateApplication -> Maybe Bool
$sel:opsItemSNSTopicArn:UpdateApplication' :: UpdateApplication -> Maybe Text
$sel:opsCenterEnabled:UpdateApplication' :: UpdateApplication -> Maybe Bool
$sel:cWEMonitorEnabled:UpdateApplication' :: UpdateApplication -> Maybe Bool
$sel:autoConfigEnabled:UpdateApplication' :: UpdateApplication -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AutoConfigEnabled" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
autoConfigEnabled,
            (Key
"CWEMonitorEnabled" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
cWEMonitorEnabled,
            (Key
"OpsCenterEnabled" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
opsCenterEnabled,
            (Key
"OpsItemSNSTopicArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
opsItemSNSTopicArn,
            (Key
"RemoveSNSTopic" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
removeSNSTopic,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ResourceGroupName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceGroupName)
          ]
      )

instance Data.ToPath UpdateApplication where
  toPath :: UpdateApplication -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newUpdateApplicationResponse' smart constructor.
data UpdateApplicationResponse = UpdateApplicationResponse'
  { -- | Information about the application.
    UpdateApplicationResponse -> Maybe ApplicationInfo
applicationInfo :: Prelude.Maybe ApplicationInfo,
    -- | The response's http status code.
    UpdateApplicationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateApplicationResponse -> UpdateApplicationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateApplicationResponse -> UpdateApplicationResponse -> Bool
$c/= :: UpdateApplicationResponse -> UpdateApplicationResponse -> Bool
== :: UpdateApplicationResponse -> UpdateApplicationResponse -> Bool
$c== :: UpdateApplicationResponse -> UpdateApplicationResponse -> Bool
Prelude.Eq, ReadPrec [UpdateApplicationResponse]
ReadPrec UpdateApplicationResponse
Int -> ReadS UpdateApplicationResponse
ReadS [UpdateApplicationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateApplicationResponse]
$creadListPrec :: ReadPrec [UpdateApplicationResponse]
readPrec :: ReadPrec UpdateApplicationResponse
$creadPrec :: ReadPrec UpdateApplicationResponse
readList :: ReadS [UpdateApplicationResponse]
$creadList :: ReadS [UpdateApplicationResponse]
readsPrec :: Int -> ReadS UpdateApplicationResponse
$creadsPrec :: Int -> ReadS UpdateApplicationResponse
Prelude.Read, Int -> UpdateApplicationResponse -> ShowS
[UpdateApplicationResponse] -> ShowS
UpdateApplicationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateApplicationResponse] -> ShowS
$cshowList :: [UpdateApplicationResponse] -> ShowS
show :: UpdateApplicationResponse -> String
$cshow :: UpdateApplicationResponse -> String
showsPrec :: Int -> UpdateApplicationResponse -> ShowS
$cshowsPrec :: Int -> UpdateApplicationResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateApplicationResponse x -> UpdateApplicationResponse
forall x.
UpdateApplicationResponse -> Rep UpdateApplicationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateApplicationResponse x -> UpdateApplicationResponse
$cfrom :: forall x.
UpdateApplicationResponse -> Rep UpdateApplicationResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateApplicationResponse' 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:
--
-- 'applicationInfo', 'updateApplicationResponse_applicationInfo' - Information about the application.
--
-- 'httpStatus', 'updateApplicationResponse_httpStatus' - The response's http status code.
newUpdateApplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateApplicationResponse
newUpdateApplicationResponse :: Int -> UpdateApplicationResponse
newUpdateApplicationResponse Int
pHttpStatus_ =
  UpdateApplicationResponse'
    { $sel:applicationInfo:UpdateApplicationResponse' :: Maybe ApplicationInfo
applicationInfo =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateApplicationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the application.
updateApplicationResponse_applicationInfo :: Lens.Lens' UpdateApplicationResponse (Prelude.Maybe ApplicationInfo)
updateApplicationResponse_applicationInfo :: Lens' UpdateApplicationResponse (Maybe ApplicationInfo)
updateApplicationResponse_applicationInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplicationResponse' {Maybe ApplicationInfo
applicationInfo :: Maybe ApplicationInfo
$sel:applicationInfo:UpdateApplicationResponse' :: UpdateApplicationResponse -> Maybe ApplicationInfo
applicationInfo} -> Maybe ApplicationInfo
applicationInfo) (\s :: UpdateApplicationResponse
s@UpdateApplicationResponse' {} Maybe ApplicationInfo
a -> UpdateApplicationResponse
s {$sel:applicationInfo:UpdateApplicationResponse' :: Maybe ApplicationInfo
applicationInfo = Maybe ApplicationInfo
a} :: UpdateApplicationResponse)

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

instance Prelude.NFData UpdateApplicationResponse where
  rnf :: UpdateApplicationResponse -> ()
rnf UpdateApplicationResponse' {Int
Maybe ApplicationInfo
httpStatus :: Int
applicationInfo :: Maybe ApplicationInfo
$sel:httpStatus:UpdateApplicationResponse' :: UpdateApplicationResponse -> Int
$sel:applicationInfo:UpdateApplicationResponse' :: UpdateApplicationResponse -> Maybe ApplicationInfo
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ApplicationInfo
applicationInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus