{-# 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.CostExplorer.CreateAnomalyMonitor
-- 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 new cost anomaly detection monitor with the requested type and
-- monitor specification.
module Amazonka.CostExplorer.CreateAnomalyMonitor
  ( -- * Creating a Request
    CreateAnomalyMonitor (..),
    newCreateAnomalyMonitor,

    -- * Request Lenses
    createAnomalyMonitor_resourceTags,
    createAnomalyMonitor_anomalyMonitor,

    -- * Destructuring the Response
    CreateAnomalyMonitorResponse (..),
    newCreateAnomalyMonitorResponse,

    -- * Response Lenses
    createAnomalyMonitorResponse_httpStatus,
    createAnomalyMonitorResponse_monitorArn,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.CostExplorer.Types
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:/ 'newCreateAnomalyMonitor' smart constructor.
data CreateAnomalyMonitor = CreateAnomalyMonitor'
  { -- | An optional list of tags to associate with the specified
    -- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_AnomalyMonitor.html AnomalyMonitor>
    -- . You can use resource tags to control access to your @monitor@ using
    -- IAM policies.
    --
    -- Each tag consists of a key and a value, and each key must be unique for
    -- the resource. The following restrictions apply to resource tags:
    --
    -- -   Although the maximum number of array members is 200, you can assign
    --     a maximum of 50 user-tags to one resource. The remaining are
    --     reserved for Amazon Web Services use
    --
    -- -   The maximum length of a key is 128 characters
    --
    -- -   The maximum length of a value is 256 characters
    --
    -- -   Keys and values can only contain alphanumeric characters, spaces,
    --     and any of the following: @_.:\/=+\@-@
    --
    -- -   Keys and values are case sensitive
    --
    -- -   Keys and values are trimmed for any leading or trailing whitespaces
    --
    -- -   Don’t use @aws:@ as a prefix for your keys. This prefix is reserved
    --     for Amazon Web Services use
    CreateAnomalyMonitor -> Maybe [ResourceTag]
resourceTags :: Prelude.Maybe [ResourceTag],
    -- | The cost anomaly detection monitor object that you want to create.
    CreateAnomalyMonitor -> AnomalyMonitor
anomalyMonitor :: AnomalyMonitor
  }
  deriving (CreateAnomalyMonitor -> CreateAnomalyMonitor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAnomalyMonitor -> CreateAnomalyMonitor -> Bool
$c/= :: CreateAnomalyMonitor -> CreateAnomalyMonitor -> Bool
== :: CreateAnomalyMonitor -> CreateAnomalyMonitor -> Bool
$c== :: CreateAnomalyMonitor -> CreateAnomalyMonitor -> Bool
Prelude.Eq, ReadPrec [CreateAnomalyMonitor]
ReadPrec CreateAnomalyMonitor
Int -> ReadS CreateAnomalyMonitor
ReadS [CreateAnomalyMonitor]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAnomalyMonitor]
$creadListPrec :: ReadPrec [CreateAnomalyMonitor]
readPrec :: ReadPrec CreateAnomalyMonitor
$creadPrec :: ReadPrec CreateAnomalyMonitor
readList :: ReadS [CreateAnomalyMonitor]
$creadList :: ReadS [CreateAnomalyMonitor]
readsPrec :: Int -> ReadS CreateAnomalyMonitor
$creadsPrec :: Int -> ReadS CreateAnomalyMonitor
Prelude.Read, Int -> CreateAnomalyMonitor -> ShowS
[CreateAnomalyMonitor] -> ShowS
CreateAnomalyMonitor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAnomalyMonitor] -> ShowS
$cshowList :: [CreateAnomalyMonitor] -> ShowS
show :: CreateAnomalyMonitor -> String
$cshow :: CreateAnomalyMonitor -> String
showsPrec :: Int -> CreateAnomalyMonitor -> ShowS
$cshowsPrec :: Int -> CreateAnomalyMonitor -> ShowS
Prelude.Show, forall x. Rep CreateAnomalyMonitor x -> CreateAnomalyMonitor
forall x. CreateAnomalyMonitor -> Rep CreateAnomalyMonitor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAnomalyMonitor x -> CreateAnomalyMonitor
$cfrom :: forall x. CreateAnomalyMonitor -> Rep CreateAnomalyMonitor x
Prelude.Generic)

-- |
-- Create a value of 'CreateAnomalyMonitor' 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:
--
-- 'resourceTags', 'createAnomalyMonitor_resourceTags' - An optional list of tags to associate with the specified
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_AnomalyMonitor.html AnomalyMonitor>
-- . You can use resource tags to control access to your @monitor@ using
-- IAM policies.
--
-- Each tag consists of a key and a value, and each key must be unique for
-- the resource. The following restrictions apply to resource tags:
--
-- -   Although the maximum number of array members is 200, you can assign
--     a maximum of 50 user-tags to one resource. The remaining are
--     reserved for Amazon Web Services use
--
-- -   The maximum length of a key is 128 characters
--
-- -   The maximum length of a value is 256 characters
--
-- -   Keys and values can only contain alphanumeric characters, spaces,
--     and any of the following: @_.:\/=+\@-@
--
-- -   Keys and values are case sensitive
--
-- -   Keys and values are trimmed for any leading or trailing whitespaces
--
-- -   Don’t use @aws:@ as a prefix for your keys. This prefix is reserved
--     for Amazon Web Services use
--
-- 'anomalyMonitor', 'createAnomalyMonitor_anomalyMonitor' - The cost anomaly detection monitor object that you want to create.
newCreateAnomalyMonitor ::
  -- | 'anomalyMonitor'
  AnomalyMonitor ->
  CreateAnomalyMonitor
newCreateAnomalyMonitor :: AnomalyMonitor -> CreateAnomalyMonitor
newCreateAnomalyMonitor AnomalyMonitor
pAnomalyMonitor_ =
  CreateAnomalyMonitor'
    { $sel:resourceTags:CreateAnomalyMonitor' :: Maybe [ResourceTag]
resourceTags =
        forall a. Maybe a
Prelude.Nothing,
      $sel:anomalyMonitor:CreateAnomalyMonitor' :: AnomalyMonitor
anomalyMonitor = AnomalyMonitor
pAnomalyMonitor_
    }

-- | An optional list of tags to associate with the specified
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_AnomalyMonitor.html AnomalyMonitor>
-- . You can use resource tags to control access to your @monitor@ using
-- IAM policies.
--
-- Each tag consists of a key and a value, and each key must be unique for
-- the resource. The following restrictions apply to resource tags:
--
-- -   Although the maximum number of array members is 200, you can assign
--     a maximum of 50 user-tags to one resource. The remaining are
--     reserved for Amazon Web Services use
--
-- -   The maximum length of a key is 128 characters
--
-- -   The maximum length of a value is 256 characters
--
-- -   Keys and values can only contain alphanumeric characters, spaces,
--     and any of the following: @_.:\/=+\@-@
--
-- -   Keys and values are case sensitive
--
-- -   Keys and values are trimmed for any leading or trailing whitespaces
--
-- -   Don’t use @aws:@ as a prefix for your keys. This prefix is reserved
--     for Amazon Web Services use
createAnomalyMonitor_resourceTags :: Lens.Lens' CreateAnomalyMonitor (Prelude.Maybe [ResourceTag])
createAnomalyMonitor_resourceTags :: Lens' CreateAnomalyMonitor (Maybe [ResourceTag])
createAnomalyMonitor_resourceTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAnomalyMonitor' {Maybe [ResourceTag]
resourceTags :: Maybe [ResourceTag]
$sel:resourceTags:CreateAnomalyMonitor' :: CreateAnomalyMonitor -> Maybe [ResourceTag]
resourceTags} -> Maybe [ResourceTag]
resourceTags) (\s :: CreateAnomalyMonitor
s@CreateAnomalyMonitor' {} Maybe [ResourceTag]
a -> CreateAnomalyMonitor
s {$sel:resourceTags:CreateAnomalyMonitor' :: Maybe [ResourceTag]
resourceTags = Maybe [ResourceTag]
a} :: CreateAnomalyMonitor) 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 cost anomaly detection monitor object that you want to create.
createAnomalyMonitor_anomalyMonitor :: Lens.Lens' CreateAnomalyMonitor AnomalyMonitor
createAnomalyMonitor_anomalyMonitor :: Lens' CreateAnomalyMonitor AnomalyMonitor
createAnomalyMonitor_anomalyMonitor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAnomalyMonitor' {AnomalyMonitor
anomalyMonitor :: AnomalyMonitor
$sel:anomalyMonitor:CreateAnomalyMonitor' :: CreateAnomalyMonitor -> AnomalyMonitor
anomalyMonitor} -> AnomalyMonitor
anomalyMonitor) (\s :: CreateAnomalyMonitor
s@CreateAnomalyMonitor' {} AnomalyMonitor
a -> CreateAnomalyMonitor
s {$sel:anomalyMonitor:CreateAnomalyMonitor' :: AnomalyMonitor
anomalyMonitor = AnomalyMonitor
a} :: CreateAnomalyMonitor)

instance Core.AWSRequest CreateAnomalyMonitor where
  type
    AWSResponse CreateAnomalyMonitor =
      CreateAnomalyMonitorResponse
  request :: (Service -> Service)
-> CreateAnomalyMonitor -> Request CreateAnomalyMonitor
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 CreateAnomalyMonitor
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateAnomalyMonitor)))
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 ->
          Int -> Text -> CreateAnomalyMonitorResponse
CreateAnomalyMonitorResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"MonitorArn")
      )

instance Prelude.Hashable CreateAnomalyMonitor where
  hashWithSalt :: Int -> CreateAnomalyMonitor -> Int
hashWithSalt Int
_salt CreateAnomalyMonitor' {Maybe [ResourceTag]
AnomalyMonitor
anomalyMonitor :: AnomalyMonitor
resourceTags :: Maybe [ResourceTag]
$sel:anomalyMonitor:CreateAnomalyMonitor' :: CreateAnomalyMonitor -> AnomalyMonitor
$sel:resourceTags:CreateAnomalyMonitor' :: CreateAnomalyMonitor -> Maybe [ResourceTag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ResourceTag]
resourceTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AnomalyMonitor
anomalyMonitor

instance Prelude.NFData CreateAnomalyMonitor where
  rnf :: CreateAnomalyMonitor -> ()
rnf CreateAnomalyMonitor' {Maybe [ResourceTag]
AnomalyMonitor
anomalyMonitor :: AnomalyMonitor
resourceTags :: Maybe [ResourceTag]
$sel:anomalyMonitor:CreateAnomalyMonitor' :: CreateAnomalyMonitor -> AnomalyMonitor
$sel:resourceTags:CreateAnomalyMonitor' :: CreateAnomalyMonitor -> Maybe [ResourceTag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ResourceTag]
resourceTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AnomalyMonitor
anomalyMonitor

instance Data.ToHeaders CreateAnomalyMonitor where
  toHeaders :: CreateAnomalyMonitor -> 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
"AWSInsightsIndexService.CreateAnomalyMonitor" ::
                          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 CreateAnomalyMonitor where
  toJSON :: CreateAnomalyMonitor -> Value
toJSON CreateAnomalyMonitor' {Maybe [ResourceTag]
AnomalyMonitor
anomalyMonitor :: AnomalyMonitor
resourceTags :: Maybe [ResourceTag]
$sel:anomalyMonitor:CreateAnomalyMonitor' :: CreateAnomalyMonitor -> AnomalyMonitor
$sel:resourceTags:CreateAnomalyMonitor' :: CreateAnomalyMonitor -> Maybe [ResourceTag]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ResourceTags" 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 [ResourceTag]
resourceTags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AnomalyMonitor" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AnomalyMonitor
anomalyMonitor)
          ]
      )

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

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

-- | /See:/ 'newCreateAnomalyMonitorResponse' smart constructor.
data CreateAnomalyMonitorResponse = CreateAnomalyMonitorResponse'
  { -- | The response's http status code.
    CreateAnomalyMonitorResponse -> Int
httpStatus :: Prelude.Int,
    -- | The unique identifier of your newly created cost anomaly detection
    -- monitor.
    CreateAnomalyMonitorResponse -> Text
monitorArn :: Prelude.Text
  }
  deriving (CreateAnomalyMonitorResponse
-> CreateAnomalyMonitorResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAnomalyMonitorResponse
-> CreateAnomalyMonitorResponse -> Bool
$c/= :: CreateAnomalyMonitorResponse
-> CreateAnomalyMonitorResponse -> Bool
== :: CreateAnomalyMonitorResponse
-> CreateAnomalyMonitorResponse -> Bool
$c== :: CreateAnomalyMonitorResponse
-> CreateAnomalyMonitorResponse -> Bool
Prelude.Eq, ReadPrec [CreateAnomalyMonitorResponse]
ReadPrec CreateAnomalyMonitorResponse
Int -> ReadS CreateAnomalyMonitorResponse
ReadS [CreateAnomalyMonitorResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAnomalyMonitorResponse]
$creadListPrec :: ReadPrec [CreateAnomalyMonitorResponse]
readPrec :: ReadPrec CreateAnomalyMonitorResponse
$creadPrec :: ReadPrec CreateAnomalyMonitorResponse
readList :: ReadS [CreateAnomalyMonitorResponse]
$creadList :: ReadS [CreateAnomalyMonitorResponse]
readsPrec :: Int -> ReadS CreateAnomalyMonitorResponse
$creadsPrec :: Int -> ReadS CreateAnomalyMonitorResponse
Prelude.Read, Int -> CreateAnomalyMonitorResponse -> ShowS
[CreateAnomalyMonitorResponse] -> ShowS
CreateAnomalyMonitorResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAnomalyMonitorResponse] -> ShowS
$cshowList :: [CreateAnomalyMonitorResponse] -> ShowS
show :: CreateAnomalyMonitorResponse -> String
$cshow :: CreateAnomalyMonitorResponse -> String
showsPrec :: Int -> CreateAnomalyMonitorResponse -> ShowS
$cshowsPrec :: Int -> CreateAnomalyMonitorResponse -> ShowS
Prelude.Show, forall x.
Rep CreateAnomalyMonitorResponse x -> CreateAnomalyMonitorResponse
forall x.
CreateAnomalyMonitorResponse -> Rep CreateAnomalyMonitorResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateAnomalyMonitorResponse x -> CreateAnomalyMonitorResponse
$cfrom :: forall x.
CreateAnomalyMonitorResponse -> Rep CreateAnomalyMonitorResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateAnomalyMonitorResponse' 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', 'createAnomalyMonitorResponse_httpStatus' - The response's http status code.
--
-- 'monitorArn', 'createAnomalyMonitorResponse_monitorArn' - The unique identifier of your newly created cost anomaly detection
-- monitor.
newCreateAnomalyMonitorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'monitorArn'
  Prelude.Text ->
  CreateAnomalyMonitorResponse
newCreateAnomalyMonitorResponse :: Int -> Text -> CreateAnomalyMonitorResponse
newCreateAnomalyMonitorResponse
  Int
pHttpStatus_
  Text
pMonitorArn_ =
    CreateAnomalyMonitorResponse'
      { $sel:httpStatus:CreateAnomalyMonitorResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:monitorArn:CreateAnomalyMonitorResponse' :: Text
monitorArn = Text
pMonitorArn_
      }

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

-- | The unique identifier of your newly created cost anomaly detection
-- monitor.
createAnomalyMonitorResponse_monitorArn :: Lens.Lens' CreateAnomalyMonitorResponse Prelude.Text
createAnomalyMonitorResponse_monitorArn :: Lens' CreateAnomalyMonitorResponse Text
createAnomalyMonitorResponse_monitorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAnomalyMonitorResponse' {Text
monitorArn :: Text
$sel:monitorArn:CreateAnomalyMonitorResponse' :: CreateAnomalyMonitorResponse -> Text
monitorArn} -> Text
monitorArn) (\s :: CreateAnomalyMonitorResponse
s@CreateAnomalyMonitorResponse' {} Text
a -> CreateAnomalyMonitorResponse
s {$sel:monitorArn:CreateAnomalyMonitorResponse' :: Text
monitorArn = Text
a} :: CreateAnomalyMonitorResponse)

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