{-# 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.ListAppMonitors
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of the Amazon CloudWatch RUM app monitors in the account.
--
-- This operation returns paginated results.
module Amazonka.Rum.ListAppMonitors
  ( -- * Creating a Request
    ListAppMonitors (..),
    newListAppMonitors,

    -- * Request Lenses
    listAppMonitors_maxResults,
    listAppMonitors_nextToken,

    -- * Destructuring the Response
    ListAppMonitorsResponse (..),
    newListAppMonitorsResponse,

    -- * Response Lenses
    listAppMonitorsResponse_appMonitorSummaries,
    listAppMonitorsResponse_nextToken,
    listAppMonitorsResponse_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:/ 'newListAppMonitors' smart constructor.
data ListAppMonitors = ListAppMonitors'
  { -- | The maximum number of results to return in one operation. The default is
    -- 50. The maximum that you can specify is 100.
    ListAppMonitors -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Use the token returned by the previous operation to request the next
    -- page of results.
    ListAppMonitors -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListAppMonitors -> ListAppMonitors -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAppMonitors -> ListAppMonitors -> Bool
$c/= :: ListAppMonitors -> ListAppMonitors -> Bool
== :: ListAppMonitors -> ListAppMonitors -> Bool
$c== :: ListAppMonitors -> ListAppMonitors -> Bool
Prelude.Eq, ReadPrec [ListAppMonitors]
ReadPrec ListAppMonitors
Int -> ReadS ListAppMonitors
ReadS [ListAppMonitors]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAppMonitors]
$creadListPrec :: ReadPrec [ListAppMonitors]
readPrec :: ReadPrec ListAppMonitors
$creadPrec :: ReadPrec ListAppMonitors
readList :: ReadS [ListAppMonitors]
$creadList :: ReadS [ListAppMonitors]
readsPrec :: Int -> ReadS ListAppMonitors
$creadsPrec :: Int -> ReadS ListAppMonitors
Prelude.Read, Int -> ListAppMonitors -> ShowS
[ListAppMonitors] -> ShowS
ListAppMonitors -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAppMonitors] -> ShowS
$cshowList :: [ListAppMonitors] -> ShowS
show :: ListAppMonitors -> String
$cshow :: ListAppMonitors -> String
showsPrec :: Int -> ListAppMonitors -> ShowS
$cshowsPrec :: Int -> ListAppMonitors -> ShowS
Prelude.Show, forall x. Rep ListAppMonitors x -> ListAppMonitors
forall x. ListAppMonitors -> Rep ListAppMonitors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListAppMonitors x -> ListAppMonitors
$cfrom :: forall x. ListAppMonitors -> Rep ListAppMonitors x
Prelude.Generic)

-- |
-- Create a value of 'ListAppMonitors' 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:
--
-- 'maxResults', 'listAppMonitors_maxResults' - The maximum number of results to return in one operation. The default is
-- 50. The maximum that you can specify is 100.
--
-- 'nextToken', 'listAppMonitors_nextToken' - Use the token returned by the previous operation to request the next
-- page of results.
newListAppMonitors ::
  ListAppMonitors
newListAppMonitors :: ListAppMonitors
newListAppMonitors =
  ListAppMonitors'
    { $sel:maxResults:ListAppMonitors' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListAppMonitors' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of results to return in one operation. The default is
-- 50. The maximum that you can specify is 100.
listAppMonitors_maxResults :: Lens.Lens' ListAppMonitors (Prelude.Maybe Prelude.Natural)
listAppMonitors_maxResults :: Lens' ListAppMonitors (Maybe Natural)
listAppMonitors_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAppMonitors' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListAppMonitors' :: ListAppMonitors -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListAppMonitors
s@ListAppMonitors' {} Maybe Natural
a -> ListAppMonitors
s {$sel:maxResults:ListAppMonitors' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListAppMonitors)

-- | Use the token returned by the previous operation to request the next
-- page of results.
listAppMonitors_nextToken :: Lens.Lens' ListAppMonitors (Prelude.Maybe Prelude.Text)
listAppMonitors_nextToken :: Lens' ListAppMonitors (Maybe Text)
listAppMonitors_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAppMonitors' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListAppMonitors' :: ListAppMonitors -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListAppMonitors
s@ListAppMonitors' {} Maybe Text
a -> ListAppMonitors
s {$sel:nextToken:ListAppMonitors' :: Maybe Text
nextToken = Maybe Text
a} :: ListAppMonitors)

instance Core.AWSPager ListAppMonitors where
  page :: ListAppMonitors
-> AWSResponse ListAppMonitors -> Maybe ListAppMonitors
page ListAppMonitors
rq AWSResponse ListAppMonitors
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListAppMonitors
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAppMonitorsResponse (Maybe Text)
listAppMonitorsResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListAppMonitors
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAppMonitorsResponse (Maybe [AppMonitorSummary])
listAppMonitorsResponse_appMonitorSummaries
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListAppMonitors
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListAppMonitors (Maybe Text)
listAppMonitors_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListAppMonitors
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAppMonitorsResponse (Maybe Text)
listAppMonitorsResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListAppMonitors where
  type
    AWSResponse ListAppMonitors =
      ListAppMonitorsResponse
  request :: (Service -> Service) -> ListAppMonitors -> Request ListAppMonitors
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 ListAppMonitors
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListAppMonitors)))
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 [AppMonitorSummary]
-> Maybe Text -> Int -> ListAppMonitorsResponse
ListAppMonitorsResponse'
            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
"AppMonitorSummaries"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"NextToken")
            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 ListAppMonitors where
  hashWithSalt :: Int -> ListAppMonitors -> Int
hashWithSalt Int
_salt ListAppMonitors' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListAppMonitors' :: ListAppMonitors -> Maybe Text
$sel:maxResults:ListAppMonitors' :: ListAppMonitors -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListAppMonitors where
  rnf :: ListAppMonitors -> ()
rnf ListAppMonitors' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListAppMonitors' :: ListAppMonitors -> Maybe Text
$sel:maxResults:ListAppMonitors' :: ListAppMonitors -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders ListAppMonitors where
  toHeaders :: ListAppMonitors -> 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 ListAppMonitors where
  toJSON :: ListAppMonitors -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

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

instance Data.ToQuery ListAppMonitors where
  toQuery :: ListAppMonitors -> QueryString
toQuery ListAppMonitors' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListAppMonitors' :: ListAppMonitors -> Maybe Text
$sel:maxResults:ListAppMonitors' :: ListAppMonitors -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | /See:/ 'newListAppMonitorsResponse' smart constructor.
data ListAppMonitorsResponse = ListAppMonitorsResponse'
  { -- | An array of structures that contain information about the returned app
    -- monitors.
    ListAppMonitorsResponse -> Maybe [AppMonitorSummary]
appMonitorSummaries :: Prelude.Maybe [AppMonitorSummary],
    -- | A token that you can use in a subsequent operation to retrieve the next
    -- set of results.
    ListAppMonitorsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListAppMonitorsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListAppMonitorsResponse -> ListAppMonitorsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAppMonitorsResponse -> ListAppMonitorsResponse -> Bool
$c/= :: ListAppMonitorsResponse -> ListAppMonitorsResponse -> Bool
== :: ListAppMonitorsResponse -> ListAppMonitorsResponse -> Bool
$c== :: ListAppMonitorsResponse -> ListAppMonitorsResponse -> Bool
Prelude.Eq, ReadPrec [ListAppMonitorsResponse]
ReadPrec ListAppMonitorsResponse
Int -> ReadS ListAppMonitorsResponse
ReadS [ListAppMonitorsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAppMonitorsResponse]
$creadListPrec :: ReadPrec [ListAppMonitorsResponse]
readPrec :: ReadPrec ListAppMonitorsResponse
$creadPrec :: ReadPrec ListAppMonitorsResponse
readList :: ReadS [ListAppMonitorsResponse]
$creadList :: ReadS [ListAppMonitorsResponse]
readsPrec :: Int -> ReadS ListAppMonitorsResponse
$creadsPrec :: Int -> ReadS ListAppMonitorsResponse
Prelude.Read, Int -> ListAppMonitorsResponse -> ShowS
[ListAppMonitorsResponse] -> ShowS
ListAppMonitorsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAppMonitorsResponse] -> ShowS
$cshowList :: [ListAppMonitorsResponse] -> ShowS
show :: ListAppMonitorsResponse -> String
$cshow :: ListAppMonitorsResponse -> String
showsPrec :: Int -> ListAppMonitorsResponse -> ShowS
$cshowsPrec :: Int -> ListAppMonitorsResponse -> ShowS
Prelude.Show, forall x. Rep ListAppMonitorsResponse x -> ListAppMonitorsResponse
forall x. ListAppMonitorsResponse -> Rep ListAppMonitorsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListAppMonitorsResponse x -> ListAppMonitorsResponse
$cfrom :: forall x. ListAppMonitorsResponse -> Rep ListAppMonitorsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListAppMonitorsResponse' 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:
--
-- 'appMonitorSummaries', 'listAppMonitorsResponse_appMonitorSummaries' - An array of structures that contain information about the returned app
-- monitors.
--
-- 'nextToken', 'listAppMonitorsResponse_nextToken' - A token that you can use in a subsequent operation to retrieve the next
-- set of results.
--
-- 'httpStatus', 'listAppMonitorsResponse_httpStatus' - The response's http status code.
newListAppMonitorsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListAppMonitorsResponse
newListAppMonitorsResponse :: Int -> ListAppMonitorsResponse
newListAppMonitorsResponse Int
pHttpStatus_ =
  ListAppMonitorsResponse'
    { $sel:appMonitorSummaries:ListAppMonitorsResponse' :: Maybe [AppMonitorSummary]
appMonitorSummaries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListAppMonitorsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListAppMonitorsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of structures that contain information about the returned app
-- monitors.
listAppMonitorsResponse_appMonitorSummaries :: Lens.Lens' ListAppMonitorsResponse (Prelude.Maybe [AppMonitorSummary])
listAppMonitorsResponse_appMonitorSummaries :: Lens' ListAppMonitorsResponse (Maybe [AppMonitorSummary])
listAppMonitorsResponse_appMonitorSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAppMonitorsResponse' {Maybe [AppMonitorSummary]
appMonitorSummaries :: Maybe [AppMonitorSummary]
$sel:appMonitorSummaries:ListAppMonitorsResponse' :: ListAppMonitorsResponse -> Maybe [AppMonitorSummary]
appMonitorSummaries} -> Maybe [AppMonitorSummary]
appMonitorSummaries) (\s :: ListAppMonitorsResponse
s@ListAppMonitorsResponse' {} Maybe [AppMonitorSummary]
a -> ListAppMonitorsResponse
s {$sel:appMonitorSummaries:ListAppMonitorsResponse' :: Maybe [AppMonitorSummary]
appMonitorSummaries = Maybe [AppMonitorSummary]
a} :: ListAppMonitorsResponse) 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

-- | A token that you can use in a subsequent operation to retrieve the next
-- set of results.
listAppMonitorsResponse_nextToken :: Lens.Lens' ListAppMonitorsResponse (Prelude.Maybe Prelude.Text)
listAppMonitorsResponse_nextToken :: Lens' ListAppMonitorsResponse (Maybe Text)
listAppMonitorsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAppMonitorsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListAppMonitorsResponse' :: ListAppMonitorsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListAppMonitorsResponse
s@ListAppMonitorsResponse' {} Maybe Text
a -> ListAppMonitorsResponse
s {$sel:nextToken:ListAppMonitorsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListAppMonitorsResponse)

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

instance Prelude.NFData ListAppMonitorsResponse where
  rnf :: ListAppMonitorsResponse -> ()
rnf ListAppMonitorsResponse' {Int
Maybe [AppMonitorSummary]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
appMonitorSummaries :: Maybe [AppMonitorSummary]
$sel:httpStatus:ListAppMonitorsResponse' :: ListAppMonitorsResponse -> Int
$sel:nextToken:ListAppMonitorsResponse' :: ListAppMonitorsResponse -> Maybe Text
$sel:appMonitorSummaries:ListAppMonitorsResponse' :: ListAppMonitorsResponse -> Maybe [AppMonitorSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AppMonitorSummary]
appMonitorSummaries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus