{-# 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.CreateAppMonitor
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a Amazon CloudWatch RUM app monitor, which collects telemetry
-- data from your application and sends that data to RUM. The data includes
-- performance and reliability information such as page load time,
-- client-side errors, and user behavior.
--
-- You use this operation only to create a new app monitor. To update an
-- existing app monitor, use
-- <https://docs.aws.amazon.com/cloudwatchrum/latest/APIReference/API_UpdateAppMonitor.html UpdateAppMonitor>
-- instead.
--
-- After you create an app monitor, sign in to the CloudWatch RUM console
-- to get the 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.CreateAppMonitor
  ( -- * Creating a Request
    CreateAppMonitor (..),
    newCreateAppMonitor,

    -- * Request Lenses
    createAppMonitor_appMonitorConfiguration,
    createAppMonitor_customEvents,
    createAppMonitor_cwLogEnabled,
    createAppMonitor_tags,
    createAppMonitor_domain,
    createAppMonitor_name,

    -- * Destructuring the Response
    CreateAppMonitorResponse (..),
    newCreateAppMonitorResponse,

    -- * Response Lenses
    createAppMonitorResponse_id,
    createAppMonitorResponse_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:/ 'newCreateAppMonitor' smart constructor.
data CreateAppMonitor = CreateAppMonitor'
  { -- | 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>.
    --
    -- If you omit this argument, the sample rate used for RUM is set to 10% of
    -- the user sessions.
    CreateAppMonitor -> Maybe AppMonitorConfiguration
appMonitorConfiguration :: Prelude.Maybe AppMonitorConfiguration,
    -- | Specifies whether this app monitor allows the web client to define and
    -- send custom events. If you omit this parameter, custom events are
    -- @DISABLED@.
    --
    -- For more information about custom events, see
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch-RUM-custom-events.html Send custom events>.
    CreateAppMonitor -> 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.
    --
    -- If you omit this parameter, the default is @false@.
    CreateAppMonitor -> Maybe Bool
cwLogEnabled :: Prelude.Maybe Prelude.Bool,
    -- | Assigns one or more tags (key-value pairs) to the app monitor.
    --
    -- Tags can help you organize and categorize your resources. You can also
    -- use them to scope user permissions by granting a user permission to
    -- access or change only resources with certain tag values.
    --
    -- Tags don\'t have any semantic meaning to Amazon Web Services and are
    -- interpreted strictly as strings of characters.
    --
    -- You can associate as many as 50 tags with an app monitor.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services resources>.
    CreateAppMonitor -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The top-level internet domain name for which your application has
    -- administrative authority.
    CreateAppMonitor -> Text
domain :: Prelude.Text,
    -- | A name for the app monitor.
    CreateAppMonitor -> Text
name :: Prelude.Text
  }
  deriving (CreateAppMonitor -> CreateAppMonitor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAppMonitor -> CreateAppMonitor -> Bool
$c/= :: CreateAppMonitor -> CreateAppMonitor -> Bool
== :: CreateAppMonitor -> CreateAppMonitor -> Bool
$c== :: CreateAppMonitor -> CreateAppMonitor -> Bool
Prelude.Eq, ReadPrec [CreateAppMonitor]
ReadPrec CreateAppMonitor
Int -> ReadS CreateAppMonitor
ReadS [CreateAppMonitor]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAppMonitor]
$creadListPrec :: ReadPrec [CreateAppMonitor]
readPrec :: ReadPrec CreateAppMonitor
$creadPrec :: ReadPrec CreateAppMonitor
readList :: ReadS [CreateAppMonitor]
$creadList :: ReadS [CreateAppMonitor]
readsPrec :: Int -> ReadS CreateAppMonitor
$creadsPrec :: Int -> ReadS CreateAppMonitor
Prelude.Read, Int -> CreateAppMonitor -> ShowS
[CreateAppMonitor] -> ShowS
CreateAppMonitor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAppMonitor] -> ShowS
$cshowList :: [CreateAppMonitor] -> ShowS
show :: CreateAppMonitor -> String
$cshow :: CreateAppMonitor -> String
showsPrec :: Int -> CreateAppMonitor -> ShowS
$cshowsPrec :: Int -> CreateAppMonitor -> ShowS
Prelude.Show, forall x. Rep CreateAppMonitor x -> CreateAppMonitor
forall x. CreateAppMonitor -> Rep CreateAppMonitor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAppMonitor x -> CreateAppMonitor
$cfrom :: forall x. CreateAppMonitor -> Rep CreateAppMonitor x
Prelude.Generic)

-- |
-- Create a value of 'CreateAppMonitor' 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', 'createAppMonitor_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>.
--
-- If you omit this argument, the sample rate used for RUM is set to 10% of
-- the user sessions.
--
-- 'customEvents', 'createAppMonitor_customEvents' - Specifies whether this app monitor allows the web client to define and
-- send custom events. If you omit this parameter, custom events are
-- @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', 'createAppMonitor_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.
--
-- If you omit this parameter, the default is @false@.
--
-- 'tags', 'createAppMonitor_tags' - Assigns one or more tags (key-value pairs) to the app monitor.
--
-- Tags can help you organize and categorize your resources. You can also
-- use them to scope user permissions by granting a user permission to
-- access or change only resources with certain tag values.
--
-- Tags don\'t have any semantic meaning to Amazon Web Services and are
-- interpreted strictly as strings of characters.
--
-- You can associate as many as 50 tags with an app monitor.
--
-- For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services resources>.
--
-- 'domain', 'createAppMonitor_domain' - The top-level internet domain name for which your application has
-- administrative authority.
--
-- 'name', 'createAppMonitor_name' - A name for the app monitor.
newCreateAppMonitor ::
  -- | 'domain'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  CreateAppMonitor
newCreateAppMonitor :: Text -> Text -> CreateAppMonitor
newCreateAppMonitor Text
pDomain_ Text
pName_ =
  CreateAppMonitor'
    { $sel:appMonitorConfiguration:CreateAppMonitor' :: Maybe AppMonitorConfiguration
appMonitorConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:customEvents:CreateAppMonitor' :: Maybe CustomEvents
customEvents = forall a. Maybe a
Prelude.Nothing,
      $sel:cwLogEnabled:CreateAppMonitor' :: Maybe Bool
cwLogEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateAppMonitor' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:domain:CreateAppMonitor' :: Text
domain = Text
pDomain_,
      $sel:name:CreateAppMonitor' :: 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>.
--
-- If you omit this argument, the sample rate used for RUM is set to 10% of
-- the user sessions.
createAppMonitor_appMonitorConfiguration :: Lens.Lens' CreateAppMonitor (Prelude.Maybe AppMonitorConfiguration)
createAppMonitor_appMonitorConfiguration :: Lens' CreateAppMonitor (Maybe AppMonitorConfiguration)
createAppMonitor_appMonitorConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAppMonitor' {Maybe AppMonitorConfiguration
appMonitorConfiguration :: Maybe AppMonitorConfiguration
$sel:appMonitorConfiguration:CreateAppMonitor' :: CreateAppMonitor -> Maybe AppMonitorConfiguration
appMonitorConfiguration} -> Maybe AppMonitorConfiguration
appMonitorConfiguration) (\s :: CreateAppMonitor
s@CreateAppMonitor' {} Maybe AppMonitorConfiguration
a -> CreateAppMonitor
s {$sel:appMonitorConfiguration:CreateAppMonitor' :: Maybe AppMonitorConfiguration
appMonitorConfiguration = Maybe AppMonitorConfiguration
a} :: CreateAppMonitor)

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

-- | 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.
--
-- If you omit this parameter, the default is @false@.
createAppMonitor_cwLogEnabled :: Lens.Lens' CreateAppMonitor (Prelude.Maybe Prelude.Bool)
createAppMonitor_cwLogEnabled :: Lens' CreateAppMonitor (Maybe Bool)
createAppMonitor_cwLogEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAppMonitor' {Maybe Bool
cwLogEnabled :: Maybe Bool
$sel:cwLogEnabled:CreateAppMonitor' :: CreateAppMonitor -> Maybe Bool
cwLogEnabled} -> Maybe Bool
cwLogEnabled) (\s :: CreateAppMonitor
s@CreateAppMonitor' {} Maybe Bool
a -> CreateAppMonitor
s {$sel:cwLogEnabled:CreateAppMonitor' :: Maybe Bool
cwLogEnabled = Maybe Bool
a} :: CreateAppMonitor)

-- | Assigns one or more tags (key-value pairs) to the app monitor.
--
-- Tags can help you organize and categorize your resources. You can also
-- use them to scope user permissions by granting a user permission to
-- access or change only resources with certain tag values.
--
-- Tags don\'t have any semantic meaning to Amazon Web Services and are
-- interpreted strictly as strings of characters.
--
-- You can associate as many as 50 tags with an app monitor.
--
-- For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services resources>.
createAppMonitor_tags :: Lens.Lens' CreateAppMonitor (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createAppMonitor_tags :: Lens' CreateAppMonitor (Maybe (HashMap Text Text))
createAppMonitor_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAppMonitor' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateAppMonitor' :: CreateAppMonitor -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateAppMonitor
s@CreateAppMonitor' {} Maybe (HashMap Text Text)
a -> CreateAppMonitor
s {$sel:tags:CreateAppMonitor' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateAppMonitor) 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 top-level internet domain name for which your application has
-- administrative authority.
createAppMonitor_domain :: Lens.Lens' CreateAppMonitor Prelude.Text
createAppMonitor_domain :: Lens' CreateAppMonitor Text
createAppMonitor_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAppMonitor' {Text
domain :: Text
$sel:domain:CreateAppMonitor' :: CreateAppMonitor -> Text
domain} -> Text
domain) (\s :: CreateAppMonitor
s@CreateAppMonitor' {} Text
a -> CreateAppMonitor
s {$sel:domain:CreateAppMonitor' :: Text
domain = Text
a} :: CreateAppMonitor)

-- | A name for the app monitor.
createAppMonitor_name :: Lens.Lens' CreateAppMonitor Prelude.Text
createAppMonitor_name :: Lens' CreateAppMonitor Text
createAppMonitor_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAppMonitor' {Text
name :: Text
$sel:name:CreateAppMonitor' :: CreateAppMonitor -> Text
name} -> Text
name) (\s :: CreateAppMonitor
s@CreateAppMonitor' {} Text
a -> CreateAppMonitor
s {$sel:name:CreateAppMonitor' :: Text
name = Text
a} :: CreateAppMonitor)

instance Core.AWSRequest CreateAppMonitor where
  type
    AWSResponse CreateAppMonitor =
      CreateAppMonitorResponse
  request :: (Service -> Service)
-> CreateAppMonitor -> Request CreateAppMonitor
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 CreateAppMonitor
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateAppMonitor)))
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 -> Int -> CreateAppMonitorResponse
CreateAppMonitorResponse'
            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
"Id")
            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 CreateAppMonitor where
  hashWithSalt :: Int -> CreateAppMonitor -> Int
hashWithSalt Int
_salt CreateAppMonitor' {Maybe Bool
Maybe (HashMap Text Text)
Maybe CustomEvents
Maybe AppMonitorConfiguration
Text
name :: Text
domain :: Text
tags :: Maybe (HashMap Text Text)
cwLogEnabled :: Maybe Bool
customEvents :: Maybe CustomEvents
appMonitorConfiguration :: Maybe AppMonitorConfiguration
$sel:name:CreateAppMonitor' :: CreateAppMonitor -> Text
$sel:domain:CreateAppMonitor' :: CreateAppMonitor -> Text
$sel:tags:CreateAppMonitor' :: CreateAppMonitor -> Maybe (HashMap Text Text)
$sel:cwLogEnabled:CreateAppMonitor' :: CreateAppMonitor -> Maybe Bool
$sel:customEvents:CreateAppMonitor' :: CreateAppMonitor -> Maybe CustomEvents
$sel:appMonitorConfiguration:CreateAppMonitor' :: CreateAppMonitor -> 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 (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateAppMonitor where
  rnf :: CreateAppMonitor -> ()
rnf CreateAppMonitor' {Maybe Bool
Maybe (HashMap Text Text)
Maybe CustomEvents
Maybe AppMonitorConfiguration
Text
name :: Text
domain :: Text
tags :: Maybe (HashMap Text Text)
cwLogEnabled :: Maybe Bool
customEvents :: Maybe CustomEvents
appMonitorConfiguration :: Maybe AppMonitorConfiguration
$sel:name:CreateAppMonitor' :: CreateAppMonitor -> Text
$sel:domain:CreateAppMonitor' :: CreateAppMonitor -> Text
$sel:tags:CreateAppMonitor' :: CreateAppMonitor -> Maybe (HashMap Text Text)
$sel:cwLogEnabled:CreateAppMonitor' :: CreateAppMonitor -> Maybe Bool
$sel:customEvents:CreateAppMonitor' :: CreateAppMonitor -> Maybe CustomEvents
$sel:appMonitorConfiguration:CreateAppMonitor' :: CreateAppMonitor -> 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 (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreateAppMonitor where
  toHeaders :: CreateAppMonitor -> 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 CreateAppMonitor where
  toJSON :: CreateAppMonitor -> Value
toJSON CreateAppMonitor' {Maybe Bool
Maybe (HashMap Text Text)
Maybe CustomEvents
Maybe AppMonitorConfiguration
Text
name :: Text
domain :: Text
tags :: Maybe (HashMap Text Text)
cwLogEnabled :: Maybe Bool
customEvents :: Maybe CustomEvents
appMonitorConfiguration :: Maybe AppMonitorConfiguration
$sel:name:CreateAppMonitor' :: CreateAppMonitor -> Text
$sel:domain:CreateAppMonitor' :: CreateAppMonitor -> Text
$sel:tags:CreateAppMonitor' :: CreateAppMonitor -> Maybe (HashMap Text Text)
$sel:cwLogEnabled:CreateAppMonitor' :: CreateAppMonitor -> Maybe Bool
$sel:customEvents:CreateAppMonitor' :: CreateAppMonitor -> Maybe CustomEvents
$sel:appMonitorConfiguration:CreateAppMonitor' :: CreateAppMonitor -> 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
"Tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Domain" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domain),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateAppMonitorResponse' 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:
--
-- 'id', 'createAppMonitorResponse_id' - The unique ID of the new app monitor.
--
-- 'httpStatus', 'createAppMonitorResponse_httpStatus' - The response's http status code.
newCreateAppMonitorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateAppMonitorResponse
newCreateAppMonitorResponse :: Int -> CreateAppMonitorResponse
newCreateAppMonitorResponse Int
pHttpStatus_ =
  CreateAppMonitorResponse'
    { $sel:id:CreateAppMonitorResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateAppMonitorResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The unique ID of the new app monitor.
createAppMonitorResponse_id :: Lens.Lens' CreateAppMonitorResponse (Prelude.Maybe Prelude.Text)
createAppMonitorResponse_id :: Lens' CreateAppMonitorResponse (Maybe Text)
createAppMonitorResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAppMonitorResponse' {Maybe Text
id :: Maybe Text
$sel:id:CreateAppMonitorResponse' :: CreateAppMonitorResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: CreateAppMonitorResponse
s@CreateAppMonitorResponse' {} Maybe Text
a -> CreateAppMonitorResponse
s {$sel:id:CreateAppMonitorResponse' :: Maybe Text
id = Maybe Text
a} :: CreateAppMonitorResponse)

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

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