{-# 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.Route53.ListHealthChecks
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieve a list of the health checks that are associated with the
-- current Amazon Web Services account.
--
-- This operation returns paginated results.
module Amazonka.Route53.ListHealthChecks
  ( -- * Creating a Request
    ListHealthChecks (..),
    newListHealthChecks,

    -- * Request Lenses
    listHealthChecks_marker,
    listHealthChecks_maxItems,

    -- * Destructuring the Response
    ListHealthChecksResponse (..),
    newListHealthChecksResponse,

    -- * Response Lenses
    listHealthChecksResponse_nextMarker,
    listHealthChecksResponse_httpStatus,
    listHealthChecksResponse_healthChecks,
    listHealthChecksResponse_marker,
    listHealthChecksResponse_isTruncated,
    listHealthChecksResponse_maxItems,
  )
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.Route53.Types

-- | A request to retrieve a list of the health checks that are associated
-- with the current Amazon Web Services account.
--
-- /See:/ 'newListHealthChecks' smart constructor.
data ListHealthChecks = ListHealthChecks'
  { -- | If the value of @IsTruncated@ in the previous response was @true@, you
    -- have more health checks. To get another group, submit another
    -- @ListHealthChecks@ request.
    --
    -- For the value of @marker@, specify the value of @NextMarker@ from the
    -- previous response, which is the ID of the first health check that Amazon
    -- Route 53 will return if you submit another request.
    --
    -- If the value of @IsTruncated@ in the previous response was @false@,
    -- there are no more health checks to get.
    ListHealthChecks -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of health checks that you want @ListHealthChecks@ to
    -- return in response to the current request. Amazon Route 53 returns a
    -- maximum of 100 items. If you set @MaxItems@ to a value greater than 100,
    -- Route 53 returns only the first 100 health checks.
    ListHealthChecks -> Maybe Text
maxItems :: Prelude.Maybe Prelude.Text
  }
  deriving (ListHealthChecks -> ListHealthChecks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListHealthChecks -> ListHealthChecks -> Bool
$c/= :: ListHealthChecks -> ListHealthChecks -> Bool
== :: ListHealthChecks -> ListHealthChecks -> Bool
$c== :: ListHealthChecks -> ListHealthChecks -> Bool
Prelude.Eq, ReadPrec [ListHealthChecks]
ReadPrec ListHealthChecks
Int -> ReadS ListHealthChecks
ReadS [ListHealthChecks]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListHealthChecks]
$creadListPrec :: ReadPrec [ListHealthChecks]
readPrec :: ReadPrec ListHealthChecks
$creadPrec :: ReadPrec ListHealthChecks
readList :: ReadS [ListHealthChecks]
$creadList :: ReadS [ListHealthChecks]
readsPrec :: Int -> ReadS ListHealthChecks
$creadsPrec :: Int -> ReadS ListHealthChecks
Prelude.Read, Int -> ListHealthChecks -> ShowS
[ListHealthChecks] -> ShowS
ListHealthChecks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListHealthChecks] -> ShowS
$cshowList :: [ListHealthChecks] -> ShowS
show :: ListHealthChecks -> String
$cshow :: ListHealthChecks -> String
showsPrec :: Int -> ListHealthChecks -> ShowS
$cshowsPrec :: Int -> ListHealthChecks -> ShowS
Prelude.Show, forall x. Rep ListHealthChecks x -> ListHealthChecks
forall x. ListHealthChecks -> Rep ListHealthChecks x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListHealthChecks x -> ListHealthChecks
$cfrom :: forall x. ListHealthChecks -> Rep ListHealthChecks x
Prelude.Generic)

-- |
-- Create a value of 'ListHealthChecks' 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:
--
-- 'marker', 'listHealthChecks_marker' - If the value of @IsTruncated@ in the previous response was @true@, you
-- have more health checks. To get another group, submit another
-- @ListHealthChecks@ request.
--
-- For the value of @marker@, specify the value of @NextMarker@ from the
-- previous response, which is the ID of the first health check that Amazon
-- Route 53 will return if you submit another request.
--
-- If the value of @IsTruncated@ in the previous response was @false@,
-- there are no more health checks to get.
--
-- 'maxItems', 'listHealthChecks_maxItems' - The maximum number of health checks that you want @ListHealthChecks@ to
-- return in response to the current request. Amazon Route 53 returns a
-- maximum of 100 items. If you set @MaxItems@ to a value greater than 100,
-- Route 53 returns only the first 100 health checks.
newListHealthChecks ::
  ListHealthChecks
newListHealthChecks :: ListHealthChecks
newListHealthChecks =
  ListHealthChecks'
    { $sel:marker:ListHealthChecks' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxItems:ListHealthChecks' :: Maybe Text
maxItems = forall a. Maybe a
Prelude.Nothing
    }

-- | If the value of @IsTruncated@ in the previous response was @true@, you
-- have more health checks. To get another group, submit another
-- @ListHealthChecks@ request.
--
-- For the value of @marker@, specify the value of @NextMarker@ from the
-- previous response, which is the ID of the first health check that Amazon
-- Route 53 will return if you submit another request.
--
-- If the value of @IsTruncated@ in the previous response was @false@,
-- there are no more health checks to get.
listHealthChecks_marker :: Lens.Lens' ListHealthChecks (Prelude.Maybe Prelude.Text)
listHealthChecks_marker :: Lens' ListHealthChecks (Maybe Text)
listHealthChecks_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHealthChecks' {Maybe Text
marker :: Maybe Text
$sel:marker:ListHealthChecks' :: ListHealthChecks -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListHealthChecks
s@ListHealthChecks' {} Maybe Text
a -> ListHealthChecks
s {$sel:marker:ListHealthChecks' :: Maybe Text
marker = Maybe Text
a} :: ListHealthChecks)

-- | The maximum number of health checks that you want @ListHealthChecks@ to
-- return in response to the current request. Amazon Route 53 returns a
-- maximum of 100 items. If you set @MaxItems@ to a value greater than 100,
-- Route 53 returns only the first 100 health checks.
listHealthChecks_maxItems :: Lens.Lens' ListHealthChecks (Prelude.Maybe Prelude.Text)
listHealthChecks_maxItems :: Lens' ListHealthChecks (Maybe Text)
listHealthChecks_maxItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHealthChecks' {Maybe Text
maxItems :: Maybe Text
$sel:maxItems:ListHealthChecks' :: ListHealthChecks -> Maybe Text
maxItems} -> Maybe Text
maxItems) (\s :: ListHealthChecks
s@ListHealthChecks' {} Maybe Text
a -> ListHealthChecks
s {$sel:maxItems:ListHealthChecks' :: Maybe Text
maxItems = Maybe Text
a} :: ListHealthChecks)

instance Core.AWSPager ListHealthChecks where
  page :: ListHealthChecks
-> AWSResponse ListHealthChecks -> Maybe ListHealthChecks
page ListHealthChecks
rq AWSResponse ListHealthChecks
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        (AWSResponse ListHealthChecks
rs forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListHealthChecksResponse Bool
listHealthChecksResponse_isTruncated) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. Maybe a -> Bool
Prelude.isNothing
        ( AWSResponse ListHealthChecks
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListHealthChecksResponse (Maybe Text)
listHealthChecksResponse_nextMarker
            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.$ ListHealthChecks
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListHealthChecks (Maybe Text)
listHealthChecks_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListHealthChecks
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListHealthChecksResponse (Maybe Text)
listHealthChecksResponse_nextMarker
          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 ListHealthChecks where
  type
    AWSResponse ListHealthChecks =
      ListHealthChecksResponse
  request :: (Service -> Service)
-> ListHealthChecks -> Request ListHealthChecks
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListHealthChecks
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListHealthChecks)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Int
-> [HealthCheck]
-> Text
-> Bool
-> Text
-> ListHealthChecksResponse
ListHealthChecksResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"NextMarker")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"HealthChecks"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"HealthCheck"
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Marker")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"IsTruncated")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"MaxItems")
      )

instance Prelude.Hashable ListHealthChecks where
  hashWithSalt :: Int -> ListHealthChecks -> Int
hashWithSalt Int
_salt ListHealthChecks' {Maybe Text
maxItems :: Maybe Text
marker :: Maybe Text
$sel:maxItems:ListHealthChecks' :: ListHealthChecks -> Maybe Text
$sel:marker:ListHealthChecks' :: ListHealthChecks -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maxItems

instance Prelude.NFData ListHealthChecks where
  rnf :: ListHealthChecks -> ()
rnf ListHealthChecks' {Maybe Text
maxItems :: Maybe Text
marker :: Maybe Text
$sel:maxItems:ListHealthChecks' :: ListHealthChecks -> Maybe Text
$sel:marker:ListHealthChecks' :: ListHealthChecks -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
maxItems

instance Data.ToHeaders ListHealthChecks where
  toHeaders :: ListHealthChecks -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath ListHealthChecks where
  toPath :: ListHealthChecks -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2013-04-01/healthcheck"

instance Data.ToQuery ListHealthChecks where
  toQuery :: ListHealthChecks -> QueryString
toQuery ListHealthChecks' {Maybe Text
maxItems :: Maybe Text
marker :: Maybe Text
$sel:maxItems:ListHealthChecks' :: ListHealthChecks -> Maybe Text
$sel:marker:ListHealthChecks' :: ListHealthChecks -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker,
        ByteString
"maxitems" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
maxItems
      ]

-- | A complex type that contains the response to a @ListHealthChecks@
-- request.
--
-- /See:/ 'newListHealthChecksResponse' smart constructor.
data ListHealthChecksResponse = ListHealthChecksResponse'
  { -- | If @IsTruncated@ is @true@, the value of @NextMarker@ identifies the
    -- first health check that Amazon Route 53 returns if you submit another
    -- @ListHealthChecks@ request and specify the value of @NextMarker@ in the
    -- @marker@ parameter.
    ListHealthChecksResponse -> Maybe Text
nextMarker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListHealthChecksResponse -> Int
httpStatus :: Prelude.Int,
    -- | A complex type that contains one @HealthCheck@ element for each health
    -- check that is associated with the current Amazon Web Services account.
    ListHealthChecksResponse -> [HealthCheck]
healthChecks :: [HealthCheck],
    -- | For the second and subsequent calls to @ListHealthChecks@, @Marker@ is
    -- the value that you specified for the @marker@ parameter in the previous
    -- request.
    ListHealthChecksResponse -> Text
marker :: Prelude.Text,
    -- | A flag that indicates whether there are more health checks to be listed.
    -- If the response was truncated, you can get the next group of health
    -- checks by submitting another @ListHealthChecks@ request and specifying
    -- the value of @NextMarker@ in the @marker@ parameter.
    ListHealthChecksResponse -> Bool
isTruncated :: Prelude.Bool,
    -- | The value that you specified for the @maxitems@ parameter in the call to
    -- @ListHealthChecks@ that produced the current response.
    ListHealthChecksResponse -> Text
maxItems :: Prelude.Text
  }
  deriving (ListHealthChecksResponse -> ListHealthChecksResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListHealthChecksResponse -> ListHealthChecksResponse -> Bool
$c/= :: ListHealthChecksResponse -> ListHealthChecksResponse -> Bool
== :: ListHealthChecksResponse -> ListHealthChecksResponse -> Bool
$c== :: ListHealthChecksResponse -> ListHealthChecksResponse -> Bool
Prelude.Eq, ReadPrec [ListHealthChecksResponse]
ReadPrec ListHealthChecksResponse
Int -> ReadS ListHealthChecksResponse
ReadS [ListHealthChecksResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListHealthChecksResponse]
$creadListPrec :: ReadPrec [ListHealthChecksResponse]
readPrec :: ReadPrec ListHealthChecksResponse
$creadPrec :: ReadPrec ListHealthChecksResponse
readList :: ReadS [ListHealthChecksResponse]
$creadList :: ReadS [ListHealthChecksResponse]
readsPrec :: Int -> ReadS ListHealthChecksResponse
$creadsPrec :: Int -> ReadS ListHealthChecksResponse
Prelude.Read, Int -> ListHealthChecksResponse -> ShowS
[ListHealthChecksResponse] -> ShowS
ListHealthChecksResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListHealthChecksResponse] -> ShowS
$cshowList :: [ListHealthChecksResponse] -> ShowS
show :: ListHealthChecksResponse -> String
$cshow :: ListHealthChecksResponse -> String
showsPrec :: Int -> ListHealthChecksResponse -> ShowS
$cshowsPrec :: Int -> ListHealthChecksResponse -> ShowS
Prelude.Show, forall x.
Rep ListHealthChecksResponse x -> ListHealthChecksResponse
forall x.
ListHealthChecksResponse -> Rep ListHealthChecksResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListHealthChecksResponse x -> ListHealthChecksResponse
$cfrom :: forall x.
ListHealthChecksResponse -> Rep ListHealthChecksResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListHealthChecksResponse' 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:
--
-- 'nextMarker', 'listHealthChecksResponse_nextMarker' - If @IsTruncated@ is @true@, the value of @NextMarker@ identifies the
-- first health check that Amazon Route 53 returns if you submit another
-- @ListHealthChecks@ request and specify the value of @NextMarker@ in the
-- @marker@ parameter.
--
-- 'httpStatus', 'listHealthChecksResponse_httpStatus' - The response's http status code.
--
-- 'healthChecks', 'listHealthChecksResponse_healthChecks' - A complex type that contains one @HealthCheck@ element for each health
-- check that is associated with the current Amazon Web Services account.
--
-- 'marker', 'listHealthChecksResponse_marker' - For the second and subsequent calls to @ListHealthChecks@, @Marker@ is
-- the value that you specified for the @marker@ parameter in the previous
-- request.
--
-- 'isTruncated', 'listHealthChecksResponse_isTruncated' - A flag that indicates whether there are more health checks to be listed.
-- If the response was truncated, you can get the next group of health
-- checks by submitting another @ListHealthChecks@ request and specifying
-- the value of @NextMarker@ in the @marker@ parameter.
--
-- 'maxItems', 'listHealthChecksResponse_maxItems' - The value that you specified for the @maxitems@ parameter in the call to
-- @ListHealthChecks@ that produced the current response.
newListHealthChecksResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'marker'
  Prelude.Text ->
  -- | 'isTruncated'
  Prelude.Bool ->
  -- | 'maxItems'
  Prelude.Text ->
  ListHealthChecksResponse
newListHealthChecksResponse :: Int -> Text -> Bool -> Text -> ListHealthChecksResponse
newListHealthChecksResponse
  Int
pHttpStatus_
  Text
pMarker_
  Bool
pIsTruncated_
  Text
pMaxItems_ =
    ListHealthChecksResponse'
      { $sel:nextMarker:ListHealthChecksResponse' :: Maybe Text
nextMarker =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ListHealthChecksResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:healthChecks:ListHealthChecksResponse' :: [HealthCheck]
healthChecks = forall a. Monoid a => a
Prelude.mempty,
        $sel:marker:ListHealthChecksResponse' :: Text
marker = Text
pMarker_,
        $sel:isTruncated:ListHealthChecksResponse' :: Bool
isTruncated = Bool
pIsTruncated_,
        $sel:maxItems:ListHealthChecksResponse' :: Text
maxItems = Text
pMaxItems_
      }

-- | If @IsTruncated@ is @true@, the value of @NextMarker@ identifies the
-- first health check that Amazon Route 53 returns if you submit another
-- @ListHealthChecks@ request and specify the value of @NextMarker@ in the
-- @marker@ parameter.
listHealthChecksResponse_nextMarker :: Lens.Lens' ListHealthChecksResponse (Prelude.Maybe Prelude.Text)
listHealthChecksResponse_nextMarker :: Lens' ListHealthChecksResponse (Maybe Text)
listHealthChecksResponse_nextMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHealthChecksResponse' {Maybe Text
nextMarker :: Maybe Text
$sel:nextMarker:ListHealthChecksResponse' :: ListHealthChecksResponse -> Maybe Text
nextMarker} -> Maybe Text
nextMarker) (\s :: ListHealthChecksResponse
s@ListHealthChecksResponse' {} Maybe Text
a -> ListHealthChecksResponse
s {$sel:nextMarker:ListHealthChecksResponse' :: Maybe Text
nextMarker = Maybe Text
a} :: ListHealthChecksResponse)

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

-- | A complex type that contains one @HealthCheck@ element for each health
-- check that is associated with the current Amazon Web Services account.
listHealthChecksResponse_healthChecks :: Lens.Lens' ListHealthChecksResponse [HealthCheck]
listHealthChecksResponse_healthChecks :: Lens' ListHealthChecksResponse [HealthCheck]
listHealthChecksResponse_healthChecks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHealthChecksResponse' {[HealthCheck]
healthChecks :: [HealthCheck]
$sel:healthChecks:ListHealthChecksResponse' :: ListHealthChecksResponse -> [HealthCheck]
healthChecks} -> [HealthCheck]
healthChecks) (\s :: ListHealthChecksResponse
s@ListHealthChecksResponse' {} [HealthCheck]
a -> ListHealthChecksResponse
s {$sel:healthChecks:ListHealthChecksResponse' :: [HealthCheck]
healthChecks = [HealthCheck]
a} :: ListHealthChecksResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | For the second and subsequent calls to @ListHealthChecks@, @Marker@ is
-- the value that you specified for the @marker@ parameter in the previous
-- request.
listHealthChecksResponse_marker :: Lens.Lens' ListHealthChecksResponse Prelude.Text
listHealthChecksResponse_marker :: Lens' ListHealthChecksResponse Text
listHealthChecksResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHealthChecksResponse' {Text
marker :: Text
$sel:marker:ListHealthChecksResponse' :: ListHealthChecksResponse -> Text
marker} -> Text
marker) (\s :: ListHealthChecksResponse
s@ListHealthChecksResponse' {} Text
a -> ListHealthChecksResponse
s {$sel:marker:ListHealthChecksResponse' :: Text
marker = Text
a} :: ListHealthChecksResponse)

-- | A flag that indicates whether there are more health checks to be listed.
-- If the response was truncated, you can get the next group of health
-- checks by submitting another @ListHealthChecks@ request and specifying
-- the value of @NextMarker@ in the @marker@ parameter.
listHealthChecksResponse_isTruncated :: Lens.Lens' ListHealthChecksResponse Prelude.Bool
listHealthChecksResponse_isTruncated :: Lens' ListHealthChecksResponse Bool
listHealthChecksResponse_isTruncated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHealthChecksResponse' {Bool
isTruncated :: Bool
$sel:isTruncated:ListHealthChecksResponse' :: ListHealthChecksResponse -> Bool
isTruncated} -> Bool
isTruncated) (\s :: ListHealthChecksResponse
s@ListHealthChecksResponse' {} Bool
a -> ListHealthChecksResponse
s {$sel:isTruncated:ListHealthChecksResponse' :: Bool
isTruncated = Bool
a} :: ListHealthChecksResponse)

-- | The value that you specified for the @maxitems@ parameter in the call to
-- @ListHealthChecks@ that produced the current response.
listHealthChecksResponse_maxItems :: Lens.Lens' ListHealthChecksResponse Prelude.Text
listHealthChecksResponse_maxItems :: Lens' ListHealthChecksResponse Text
listHealthChecksResponse_maxItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHealthChecksResponse' {Text
maxItems :: Text
$sel:maxItems:ListHealthChecksResponse' :: ListHealthChecksResponse -> Text
maxItems} -> Text
maxItems) (\s :: ListHealthChecksResponse
s@ListHealthChecksResponse' {} Text
a -> ListHealthChecksResponse
s {$sel:maxItems:ListHealthChecksResponse' :: Text
maxItems = Text
a} :: ListHealthChecksResponse)

instance Prelude.NFData ListHealthChecksResponse where
  rnf :: ListHealthChecksResponse -> ()
rnf ListHealthChecksResponse' {Bool
Int
[HealthCheck]
Maybe Text
Text
maxItems :: Text
isTruncated :: Bool
marker :: Text
healthChecks :: [HealthCheck]
httpStatus :: Int
nextMarker :: Maybe Text
$sel:maxItems:ListHealthChecksResponse' :: ListHealthChecksResponse -> Text
$sel:isTruncated:ListHealthChecksResponse' :: ListHealthChecksResponse -> Bool
$sel:marker:ListHealthChecksResponse' :: ListHealthChecksResponse -> Text
$sel:healthChecks:ListHealthChecksResponse' :: ListHealthChecksResponse -> [HealthCheck]
$sel:httpStatus:ListHealthChecksResponse' :: ListHealthChecksResponse -> Int
$sel:nextMarker:ListHealthChecksResponse' :: ListHealthChecksResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 [HealthCheck]
healthChecks
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
isTruncated
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
maxItems