{-# 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.Rum.UpdateAppMonitor
-- 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 configuration of an existing app monitor. When you use this
-- operation, only the parts of the app monitor configuration that you
-- specify in this operation are changed. For any parameters that you omit,
-- the existing values are kept.
--
-- You can\'t use this operation to change the tags of an existing app
-- monitor. To change the tags of an existing app monitor, use
-- <https://docs.aws.amazon.com/cloudwatchrum/latest/APIReference/API_TagResource.html TagResource>.
--
-- To create a new app monitor, use
-- <https://docs.aws.amazon.com/cloudwatchrum/latest/APIReference/API_CreateAppMonitor.html CreateAppMonitor>.
--
-- After you update an app monitor, sign in to the CloudWatch RUM console
-- to get the updated JavaScript code snippet to add to your web
-- application. For more information, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch-RUM-find-code-snippet.html How do I find a code snippet that I\'ve already generated?>
module Amazonka.Rum.UpdateAppMonitor
  ( -- * Creating a Request
    UpdateAppMonitor (..),
    newUpdateAppMonitor,

    -- * Request Lenses
    updateAppMonitor_appMonitorConfiguration,
    updateAppMonitor_customEvents,
    updateAppMonitor_cwLogEnabled,
    updateAppMonitor_domain,
    updateAppMonitor_name,

    -- * Destructuring the Response
    UpdateAppMonitorResponse (..),
    newUpdateAppMonitorResponse,

    -- * Response Lenses
    updateAppMonitorResponse_httpStatus,
  )
where

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
import Amazonka.Rum.Types

-- | /See:/ 'newUpdateAppMonitor' smart constructor.
data UpdateAppMonitor = UpdateAppMonitor'
  { -- | A structure that contains much of the configuration data for the app
    -- monitor. If you are using Amazon Cognito for authorization, you must
    -- include this structure in your request, and it must include the ID of
    -- the Amazon Cognito identity pool to use for authorization. If you don\'t
    -- include @AppMonitorConfiguration@, you must set up your own
    -- authorization method. For more information, see
    -- <https://docs.aws.amazon.com/monitoring/CloudWatch-RUM-get-started-authorization.html Authorize your application to send data to Amazon Web Services>.
    UpdateAppMonitor -> Maybe AppMonitorConfiguration
appMonitorConfiguration :: Prelude.Maybe AppMonitorConfiguration,
    -- | Specifies whether this app monitor allows the web client to define and
    -- send custom events. The default is for custom events to be @DISABLED@.
    --
    -- For more information about custom events, see
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch-RUM-custom-events.html Send custom events>.
    UpdateAppMonitor -> Maybe CustomEvents
customEvents :: Prelude.Maybe CustomEvents,
    -- | Data collected by RUM is kept by RUM for 30 days and then deleted. This
    -- parameter specifies whether RUM sends a copy of this telemetry data to
    -- Amazon CloudWatch Logs in your account. This enables you to keep the
    -- telemetry data for more than 30 days, but it does incur Amazon
    -- CloudWatch Logs charges.
    UpdateAppMonitor -> Maybe Bool
cwLogEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The top-level internet domain name for which your application has
    -- administrative authority.
    UpdateAppMonitor -> Maybe Text
domain :: Prelude.Maybe Prelude.Text,
    -- | The name of the app monitor to update.
    UpdateAppMonitor -> Text
name :: Prelude.Text
  }
  deriving (UpdateAppMonitor -> UpdateAppMonitor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAppMonitor -> UpdateAppMonitor -> Bool
$c/= :: UpdateAppMonitor -> UpdateAppMonitor -> Bool
== :: UpdateAppMonitor -> UpdateAppMonitor -> Bool
$c== :: UpdateAppMonitor -> UpdateAppMonitor -> Bool
Prelude.Eq, ReadPrec [UpdateAppMonitor]
ReadPrec UpdateAppMonitor
Int -> ReadS UpdateAppMonitor
ReadS [UpdateAppMonitor]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAppMonitor]
$creadListPrec :: ReadPrec [UpdateAppMonitor]
readPrec :: ReadPrec UpdateAppMonitor
$creadPrec :: ReadPrec UpdateAppMonitor
readList :: ReadS [UpdateAppMonitor]
$creadList :: ReadS [UpdateAppMonitor]
readsPrec :: Int -> ReadS UpdateAppMonitor
$creadsPrec :: Int -> ReadS UpdateAppMonitor
Prelude.Read, Int -> UpdateAppMonitor -> ShowS
[UpdateAppMonitor] -> ShowS
UpdateAppMonitor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAppMonitor] -> ShowS
$cshowList :: [UpdateAppMonitor] -> ShowS
show :: UpdateAppMonitor -> String
$cshow :: UpdateAppMonitor -> String
showsPrec :: Int -> UpdateAppMonitor -> ShowS
$cshowsPrec :: Int -> UpdateAppMonitor -> ShowS
Prelude.Show, forall x. Rep UpdateAppMonitor x -> UpdateAppMonitor
forall x. UpdateAppMonitor -> Rep UpdateAppMonitor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateAppMonitor x -> UpdateAppMonitor
$cfrom :: forall x. UpdateAppMonitor -> Rep UpdateAppMonitor x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAppMonitor' 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:
--
-- 'appMonitorConfiguration', 'updateAppMonitor_appMonitorConfiguration' - A structure that contains much of the configuration data for the app
-- monitor. If you are using Amazon Cognito for authorization, you must
-- include this structure in your request, and it must include the ID of
-- the Amazon Cognito identity pool to use for authorization. If you don\'t
-- include @AppMonitorConfiguration@, you must set up your own
-- authorization method. For more information, see
-- <https://docs.aws.amazon.com/monitoring/CloudWatch-RUM-get-started-authorization.html Authorize your application to send data to Amazon Web Services>.
--
-- 'customEvents', 'updateAppMonitor_customEvents' - Specifies whether this app monitor allows the web client to define and
-- send custom events. The default is for custom events to be @DISABLED@.
--
-- For more information about custom events, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch-RUM-custom-events.html Send custom events>.
--
-- 'cwLogEnabled', 'updateAppMonitor_cwLogEnabled' - Data collected by RUM is kept by RUM for 30 days and then deleted. This
-- parameter specifies whether RUM sends a copy of this telemetry data to
-- Amazon CloudWatch Logs in your account. This enables you to keep the
-- telemetry data for more than 30 days, but it does incur Amazon
-- CloudWatch Logs charges.
--
-- 'domain', 'updateAppMonitor_domain' - The top-level internet domain name for which your application has
-- administrative authority.
--
-- 'name', 'updateAppMonitor_name' - The name of the app monitor to update.
newUpdateAppMonitor ::
  -- | 'name'
  Prelude.Text ->
  UpdateAppMonitor
newUpdateAppMonitor :: Text -> UpdateAppMonitor
newUpdateAppMonitor Text
pName_ =
  UpdateAppMonitor'
    { $sel:appMonitorConfiguration:UpdateAppMonitor' :: Maybe AppMonitorConfiguration
appMonitorConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:customEvents:UpdateAppMonitor' :: Maybe CustomEvents
customEvents = forall a. Maybe a
Prelude.Nothing,
      $sel:cwLogEnabled:UpdateAppMonitor' :: Maybe Bool
cwLogEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:domain:UpdateAppMonitor' :: Maybe Text
domain = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateAppMonitor' :: Text
name = Text
pName_
    }

-- | A structure that contains much of the configuration data for the app
-- monitor. If you are using Amazon Cognito for authorization, you must
-- include this structure in your request, and it must include the ID of
-- the Amazon Cognito identity pool to use for authorization. If you don\'t
-- include @AppMonitorConfiguration@, you must set up your own
-- authorization method. For more information, see
-- <https://docs.aws.amazon.com/monitoring/CloudWatch-RUM-get-started-authorization.html Authorize your application to send data to Amazon Web Services>.
updateAppMonitor_appMonitorConfiguration :: Lens.Lens' UpdateAppMonitor (Prelude.Maybe AppMonitorConfiguration)
updateAppMonitor_appMonitorConfiguration :: Lens' UpdateAppMonitor (Maybe AppMonitorConfiguration)
updateAppMonitor_appMonitorConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAppMonitor' {Maybe AppMonitorConfiguration
appMonitorConfiguration :: Maybe AppMonitorConfiguration
$sel:appMonitorConfiguration:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe AppMonitorConfiguration
appMonitorConfiguration} -> Maybe AppMonitorConfiguration
appMonitorConfiguration) (\s :: UpdateAppMonitor
s@UpdateAppMonitor' {} Maybe AppMonitorConfiguration
a -> UpdateAppMonitor
s {$sel:appMonitorConfiguration:UpdateAppMonitor' :: Maybe AppMonitorConfiguration
appMonitorConfiguration = Maybe AppMonitorConfiguration
a} :: UpdateAppMonitor)

-- | Specifies whether this app monitor allows the web client to define and
-- send custom events. The default is for custom events to be @DISABLED@.
--
-- For more information about custom events, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch-RUM-custom-events.html Send custom events>.
updateAppMonitor_customEvents :: Lens.Lens' UpdateAppMonitor (Prelude.Maybe CustomEvents)
updateAppMonitor_customEvents :: Lens' UpdateAppMonitor (Maybe CustomEvents)
updateAppMonitor_customEvents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAppMonitor' {Maybe CustomEvents
customEvents :: Maybe CustomEvents
$sel:customEvents:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe CustomEvents
customEvents} -> Maybe CustomEvents
customEvents) (\s :: UpdateAppMonitor
s@UpdateAppMonitor' {} Maybe CustomEvents
a -> UpdateAppMonitor
s {$sel:customEvents:UpdateAppMonitor' :: Maybe CustomEvents
customEvents = Maybe CustomEvents
a} :: UpdateAppMonitor)

-- | Data collected by RUM is kept by RUM for 30 days and then deleted. This
-- parameter specifies whether RUM sends a copy of this telemetry data to
-- Amazon CloudWatch Logs in your account. This enables you to keep the
-- telemetry data for more than 30 days, but it does incur Amazon
-- CloudWatch Logs charges.
updateAppMonitor_cwLogEnabled :: Lens.Lens' UpdateAppMonitor (Prelude.Maybe Prelude.Bool)
updateAppMonitor_cwLogEnabled :: Lens' UpdateAppMonitor (Maybe Bool)
updateAppMonitor_cwLogEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAppMonitor' {Maybe Bool
cwLogEnabled :: Maybe Bool
$sel:cwLogEnabled:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe Bool
cwLogEnabled} -> Maybe Bool
cwLogEnabled) (\s :: UpdateAppMonitor
s@UpdateAppMonitor' {} Maybe Bool
a -> UpdateAppMonitor
s {$sel:cwLogEnabled:UpdateAppMonitor' :: Maybe Bool
cwLogEnabled = Maybe Bool
a} :: UpdateAppMonitor)

-- | The top-level internet domain name for which your application has
-- administrative authority.
updateAppMonitor_domain :: Lens.Lens' UpdateAppMonitor (Prelude.Maybe Prelude.Text)
updateAppMonitor_domain :: Lens' UpdateAppMonitor (Maybe Text)
updateAppMonitor_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAppMonitor' {Maybe Text
domain :: Maybe Text
$sel:domain:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe Text
domain} -> Maybe Text
domain) (\s :: UpdateAppMonitor
s@UpdateAppMonitor' {} Maybe Text
a -> UpdateAppMonitor
s {$sel:domain:UpdateAppMonitor' :: Maybe Text
domain = Maybe Text
a} :: UpdateAppMonitor)

-- | The name of the app monitor to update.
updateAppMonitor_name :: Lens.Lens' UpdateAppMonitor Prelude.Text
updateAppMonitor_name :: Lens' UpdateAppMonitor Text
updateAppMonitor_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAppMonitor' {Text
name :: Text
$sel:name:UpdateAppMonitor' :: UpdateAppMonitor -> Text
name} -> Text
name) (\s :: UpdateAppMonitor
s@UpdateAppMonitor' {} Text
a -> UpdateAppMonitor
s {$sel:name:UpdateAppMonitor' :: Text
name = Text
a} :: UpdateAppMonitor)

instance Core.AWSRequest UpdateAppMonitor where
  type
    AWSResponse UpdateAppMonitor =
      UpdateAppMonitorResponse
  request :: (Service -> Service)
-> UpdateAppMonitor -> Request UpdateAppMonitor
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateAppMonitor
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateAppMonitor)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateAppMonitorResponse
UpdateAppMonitorResponse'
            forall (f :: * -> *) a b. Functor 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 UpdateAppMonitor where
  hashWithSalt :: Int -> UpdateAppMonitor -> Int
hashWithSalt Int
_salt UpdateAppMonitor' {Maybe Bool
Maybe Text
Maybe CustomEvents
Maybe AppMonitorConfiguration
Text
name :: Text
domain :: Maybe Text
cwLogEnabled :: Maybe Bool
customEvents :: Maybe CustomEvents
appMonitorConfiguration :: Maybe AppMonitorConfiguration
$sel:name:UpdateAppMonitor' :: UpdateAppMonitor -> Text
$sel:domain:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe Text
$sel:cwLogEnabled:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe Bool
$sel:customEvents:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe CustomEvents
$sel:appMonitorConfiguration:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe AppMonitorConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AppMonitorConfiguration
appMonitorConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CustomEvents
customEvents
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
cwLogEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
domain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData UpdateAppMonitor where
  rnf :: UpdateAppMonitor -> ()
rnf UpdateAppMonitor' {Maybe Bool
Maybe Text
Maybe CustomEvents
Maybe AppMonitorConfiguration
Text
name :: Text
domain :: Maybe Text
cwLogEnabled :: Maybe Bool
customEvents :: Maybe CustomEvents
appMonitorConfiguration :: Maybe AppMonitorConfiguration
$sel:name:UpdateAppMonitor' :: UpdateAppMonitor -> Text
$sel:domain:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe Text
$sel:cwLogEnabled:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe Bool
$sel:customEvents:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe CustomEvents
$sel:appMonitorConfiguration:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe AppMonitorConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AppMonitorConfiguration
appMonitorConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CustomEvents
customEvents
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
cwLogEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders UpdateAppMonitor where
  toHeaders :: UpdateAppMonitor -> 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.ToJSON UpdateAppMonitor where
  toJSON :: UpdateAppMonitor -> Value
toJSON UpdateAppMonitor' {Maybe Bool
Maybe Text
Maybe CustomEvents
Maybe AppMonitorConfiguration
Text
name :: Text
domain :: Maybe Text
cwLogEnabled :: Maybe Bool
customEvents :: Maybe CustomEvents
appMonitorConfiguration :: Maybe AppMonitorConfiguration
$sel:name:UpdateAppMonitor' :: UpdateAppMonitor -> Text
$sel:domain:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe Text
$sel:cwLogEnabled:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe Bool
$sel:customEvents:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe CustomEvents
$sel:appMonitorConfiguration:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe AppMonitorConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AppMonitorConfiguration" 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 AppMonitorConfiguration
appMonitorConfiguration,
            (Key
"CustomEvents" 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 CustomEvents
customEvents,
            (Key
"CwLogEnabled" 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
cwLogEnabled,
            (Key
"Domain" 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
domain
          ]
      )

instance Data.ToPath UpdateAppMonitor where
  toPath :: UpdateAppMonitor -> ByteString
toPath UpdateAppMonitor' {Maybe Bool
Maybe Text
Maybe CustomEvents
Maybe AppMonitorConfiguration
Text
name :: Text
domain :: Maybe Text
cwLogEnabled :: Maybe Bool
customEvents :: Maybe CustomEvents
appMonitorConfiguration :: Maybe AppMonitorConfiguration
$sel:name:UpdateAppMonitor' :: UpdateAppMonitor -> Text
$sel:domain:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe Text
$sel:cwLogEnabled:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe Bool
$sel:customEvents:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe CustomEvents
$sel:appMonitorConfiguration:UpdateAppMonitor' :: UpdateAppMonitor -> Maybe AppMonitorConfiguration
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/appmonitor/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

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

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

-- |
-- Create a value of 'UpdateAppMonitorResponse' 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:
--
-- 'httpStatus', 'updateAppMonitorResponse_httpStatus' - The response's http status code.
newUpdateAppMonitorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateAppMonitorResponse
newUpdateAppMonitorResponse :: Int -> UpdateAppMonitorResponse
newUpdateAppMonitorResponse Int
pHttpStatus_ =
  UpdateAppMonitorResponse'
    { $sel:httpStatus:UpdateAppMonitorResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData UpdateAppMonitorResponse where
  rnf :: UpdateAppMonitorResponse -> ()
rnf UpdateAppMonitorResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateAppMonitorResponse' :: UpdateAppMonitorResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus