{-# 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.Support.DescribeTrustedAdvisorCheckRefreshStatuses
-- 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 the refresh status of the Trusted Advisor checks that have the
-- specified check IDs. You can get the check IDs by calling the
-- DescribeTrustedAdvisorChecks operation.
--
-- Some checks are refreshed automatically, and you can\'t return their
-- refresh statuses by using the
-- @DescribeTrustedAdvisorCheckRefreshStatuses@ operation. If you call this
-- operation for these checks, you might see an @InvalidParameterValue@
-- error.
--
-- -   You must have a Business, Enterprise On-Ramp, or Enterprise Support
--     plan to use the Amazon Web Services Support API.
--
-- -   If you call the Amazon Web Services Support API from an account that
--     doesn\'t have a Business, Enterprise On-Ramp, or Enterprise Support
--     plan, the @SubscriptionRequiredException@ error message appears. For
--     information about changing your support plan, see
--     <http://aws.amazon.com/premiumsupport/ Amazon Web Services Support>.
--
-- To call the Trusted Advisor operations in the Amazon Web Services
-- Support API, you must use the US East (N. Virginia) endpoint. Currently,
-- the US West (Oregon) and Europe (Ireland) endpoints don\'t support the
-- Trusted Advisor operations. For more information, see
-- <https://docs.aws.amazon.com/awssupport/latest/user/about-support-api.html#endpoint About the Amazon Web Services Support API>
-- in the /Amazon Web Services Support User Guide/.
module Amazonka.Support.DescribeTrustedAdvisorCheckRefreshStatuses
  ( -- * Creating a Request
    DescribeTrustedAdvisorCheckRefreshStatuses (..),
    newDescribeTrustedAdvisorCheckRefreshStatuses,

    -- * Request Lenses
    describeTrustedAdvisorCheckRefreshStatuses_checkIds,

    -- * Destructuring the Response
    DescribeTrustedAdvisorCheckRefreshStatusesResponse (..),
    newDescribeTrustedAdvisorCheckRefreshStatusesResponse,

    -- * Response Lenses
    describeTrustedAdvisorCheckRefreshStatusesResponse_httpStatus,
    describeTrustedAdvisorCheckRefreshStatusesResponse_statuses,
  )
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.Support.Types

-- | /See:/ 'newDescribeTrustedAdvisorCheckRefreshStatuses' smart constructor.
data DescribeTrustedAdvisorCheckRefreshStatuses = DescribeTrustedAdvisorCheckRefreshStatuses'
  { -- | The IDs of the Trusted Advisor checks to get the status.
    --
    -- If you specify the check ID of a check that is automatically refreshed,
    -- you might see an @InvalidParameterValue@ error.
    DescribeTrustedAdvisorCheckRefreshStatuses -> [Text]
checkIds :: [Prelude.Text]
  }
  deriving (DescribeTrustedAdvisorCheckRefreshStatuses
-> DescribeTrustedAdvisorCheckRefreshStatuses -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeTrustedAdvisorCheckRefreshStatuses
-> DescribeTrustedAdvisorCheckRefreshStatuses -> Bool
$c/= :: DescribeTrustedAdvisorCheckRefreshStatuses
-> DescribeTrustedAdvisorCheckRefreshStatuses -> Bool
== :: DescribeTrustedAdvisorCheckRefreshStatuses
-> DescribeTrustedAdvisorCheckRefreshStatuses -> Bool
$c== :: DescribeTrustedAdvisorCheckRefreshStatuses
-> DescribeTrustedAdvisorCheckRefreshStatuses -> Bool
Prelude.Eq, ReadPrec [DescribeTrustedAdvisorCheckRefreshStatuses]
ReadPrec DescribeTrustedAdvisorCheckRefreshStatuses
Int -> ReadS DescribeTrustedAdvisorCheckRefreshStatuses
ReadS [DescribeTrustedAdvisorCheckRefreshStatuses]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeTrustedAdvisorCheckRefreshStatuses]
$creadListPrec :: ReadPrec [DescribeTrustedAdvisorCheckRefreshStatuses]
readPrec :: ReadPrec DescribeTrustedAdvisorCheckRefreshStatuses
$creadPrec :: ReadPrec DescribeTrustedAdvisorCheckRefreshStatuses
readList :: ReadS [DescribeTrustedAdvisorCheckRefreshStatuses]
$creadList :: ReadS [DescribeTrustedAdvisorCheckRefreshStatuses]
readsPrec :: Int -> ReadS DescribeTrustedAdvisorCheckRefreshStatuses
$creadsPrec :: Int -> ReadS DescribeTrustedAdvisorCheckRefreshStatuses
Prelude.Read, Int -> DescribeTrustedAdvisorCheckRefreshStatuses -> ShowS
[DescribeTrustedAdvisorCheckRefreshStatuses] -> ShowS
DescribeTrustedAdvisorCheckRefreshStatuses -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeTrustedAdvisorCheckRefreshStatuses] -> ShowS
$cshowList :: [DescribeTrustedAdvisorCheckRefreshStatuses] -> ShowS
show :: DescribeTrustedAdvisorCheckRefreshStatuses -> String
$cshow :: DescribeTrustedAdvisorCheckRefreshStatuses -> String
showsPrec :: Int -> DescribeTrustedAdvisorCheckRefreshStatuses -> ShowS
$cshowsPrec :: Int -> DescribeTrustedAdvisorCheckRefreshStatuses -> ShowS
Prelude.Show, forall x.
Rep DescribeTrustedAdvisorCheckRefreshStatuses x
-> DescribeTrustedAdvisorCheckRefreshStatuses
forall x.
DescribeTrustedAdvisorCheckRefreshStatuses
-> Rep DescribeTrustedAdvisorCheckRefreshStatuses x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeTrustedAdvisorCheckRefreshStatuses x
-> DescribeTrustedAdvisorCheckRefreshStatuses
$cfrom :: forall x.
DescribeTrustedAdvisorCheckRefreshStatuses
-> Rep DescribeTrustedAdvisorCheckRefreshStatuses x
Prelude.Generic)

-- |
-- Create a value of 'DescribeTrustedAdvisorCheckRefreshStatuses' 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:
--
-- 'checkIds', 'describeTrustedAdvisorCheckRefreshStatuses_checkIds' - The IDs of the Trusted Advisor checks to get the status.
--
-- If you specify the check ID of a check that is automatically refreshed,
-- you might see an @InvalidParameterValue@ error.
newDescribeTrustedAdvisorCheckRefreshStatuses ::
  DescribeTrustedAdvisorCheckRefreshStatuses
newDescribeTrustedAdvisorCheckRefreshStatuses :: DescribeTrustedAdvisorCheckRefreshStatuses
newDescribeTrustedAdvisorCheckRefreshStatuses =
  DescribeTrustedAdvisorCheckRefreshStatuses'
    { $sel:checkIds:DescribeTrustedAdvisorCheckRefreshStatuses' :: [Text]
checkIds =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | The IDs of the Trusted Advisor checks to get the status.
--
-- If you specify the check ID of a check that is automatically refreshed,
-- you might see an @InvalidParameterValue@ error.
describeTrustedAdvisorCheckRefreshStatuses_checkIds :: Lens.Lens' DescribeTrustedAdvisorCheckRefreshStatuses [Prelude.Text]
describeTrustedAdvisorCheckRefreshStatuses_checkIds :: Lens' DescribeTrustedAdvisorCheckRefreshStatuses [Text]
describeTrustedAdvisorCheckRefreshStatuses_checkIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTrustedAdvisorCheckRefreshStatuses' {[Text]
checkIds :: [Text]
$sel:checkIds:DescribeTrustedAdvisorCheckRefreshStatuses' :: DescribeTrustedAdvisorCheckRefreshStatuses -> [Text]
checkIds} -> [Text]
checkIds) (\s :: DescribeTrustedAdvisorCheckRefreshStatuses
s@DescribeTrustedAdvisorCheckRefreshStatuses' {} [Text]
a -> DescribeTrustedAdvisorCheckRefreshStatuses
s {$sel:checkIds:DescribeTrustedAdvisorCheckRefreshStatuses' :: [Text]
checkIds = [Text]
a} :: DescribeTrustedAdvisorCheckRefreshStatuses) 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

instance
  Core.AWSRequest
    DescribeTrustedAdvisorCheckRefreshStatuses
  where
  type
    AWSResponse
      DescribeTrustedAdvisorCheckRefreshStatuses =
      DescribeTrustedAdvisorCheckRefreshStatusesResponse
  request :: (Service -> Service)
-> DescribeTrustedAdvisorCheckRefreshStatuses
-> Request DescribeTrustedAdvisorCheckRefreshStatuses
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 DescribeTrustedAdvisorCheckRefreshStatuses
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse DescribeTrustedAdvisorCheckRefreshStatuses)))
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
-> [TrustedAdvisorCheckRefreshStatus]
-> DescribeTrustedAdvisorCheckRefreshStatusesResponse
DescribeTrustedAdvisorCheckRefreshStatusesResponse'
            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 (Maybe a)
Data..?> Key
"statuses" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance
  Prelude.Hashable
    DescribeTrustedAdvisorCheckRefreshStatuses
  where
  hashWithSalt :: Int -> DescribeTrustedAdvisorCheckRefreshStatuses -> Int
hashWithSalt
    Int
_salt
    DescribeTrustedAdvisorCheckRefreshStatuses' {[Text]
checkIds :: [Text]
$sel:checkIds:DescribeTrustedAdvisorCheckRefreshStatuses' :: DescribeTrustedAdvisorCheckRefreshStatuses -> [Text]
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
checkIds

instance
  Prelude.NFData
    DescribeTrustedAdvisorCheckRefreshStatuses
  where
  rnf :: DescribeTrustedAdvisorCheckRefreshStatuses -> ()
rnf DescribeTrustedAdvisorCheckRefreshStatuses' {[Text]
checkIds :: [Text]
$sel:checkIds:DescribeTrustedAdvisorCheckRefreshStatuses' :: DescribeTrustedAdvisorCheckRefreshStatuses -> [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [Text]
checkIds

instance
  Data.ToHeaders
    DescribeTrustedAdvisorCheckRefreshStatuses
  where
  toHeaders :: DescribeTrustedAdvisorCheckRefreshStatuses -> 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
"AWSSupport_20130415.DescribeTrustedAdvisorCheckRefreshStatuses" ::
                          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
    DescribeTrustedAdvisorCheckRefreshStatuses
  where
  toJSON :: DescribeTrustedAdvisorCheckRefreshStatuses -> Value
toJSON
    DescribeTrustedAdvisorCheckRefreshStatuses' {[Text]
checkIds :: [Text]
$sel:checkIds:DescribeTrustedAdvisorCheckRefreshStatuses' :: DescribeTrustedAdvisorCheckRefreshStatuses -> [Text]
..} =
      [Pair] -> Value
Data.object
        ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
            [forall a. a -> Maybe a
Prelude.Just (Key
"checkIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
checkIds)]
        )

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

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

-- | The statuses of the Trusted Advisor checks returned by the
-- DescribeTrustedAdvisorCheckRefreshStatuses operation.
--
-- /See:/ 'newDescribeTrustedAdvisorCheckRefreshStatusesResponse' smart constructor.
data DescribeTrustedAdvisorCheckRefreshStatusesResponse = DescribeTrustedAdvisorCheckRefreshStatusesResponse'
  { -- | The response's http status code.
    DescribeTrustedAdvisorCheckRefreshStatusesResponse -> Int
httpStatus :: Prelude.Int,
    -- | The refresh status of the specified Trusted Advisor checks.
    DescribeTrustedAdvisorCheckRefreshStatusesResponse
-> [TrustedAdvisorCheckRefreshStatus]
statuses :: [TrustedAdvisorCheckRefreshStatus]
  }
  deriving (DescribeTrustedAdvisorCheckRefreshStatusesResponse
-> DescribeTrustedAdvisorCheckRefreshStatusesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeTrustedAdvisorCheckRefreshStatusesResponse
-> DescribeTrustedAdvisorCheckRefreshStatusesResponse -> Bool
$c/= :: DescribeTrustedAdvisorCheckRefreshStatusesResponse
-> DescribeTrustedAdvisorCheckRefreshStatusesResponse -> Bool
== :: DescribeTrustedAdvisorCheckRefreshStatusesResponse
-> DescribeTrustedAdvisorCheckRefreshStatusesResponse -> Bool
$c== :: DescribeTrustedAdvisorCheckRefreshStatusesResponse
-> DescribeTrustedAdvisorCheckRefreshStatusesResponse -> Bool
Prelude.Eq, ReadPrec [DescribeTrustedAdvisorCheckRefreshStatusesResponse]
ReadPrec DescribeTrustedAdvisorCheckRefreshStatusesResponse
Int -> ReadS DescribeTrustedAdvisorCheckRefreshStatusesResponse
ReadS [DescribeTrustedAdvisorCheckRefreshStatusesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeTrustedAdvisorCheckRefreshStatusesResponse]
$creadListPrec :: ReadPrec [DescribeTrustedAdvisorCheckRefreshStatusesResponse]
readPrec :: ReadPrec DescribeTrustedAdvisorCheckRefreshStatusesResponse
$creadPrec :: ReadPrec DescribeTrustedAdvisorCheckRefreshStatusesResponse
readList :: ReadS [DescribeTrustedAdvisorCheckRefreshStatusesResponse]
$creadList :: ReadS [DescribeTrustedAdvisorCheckRefreshStatusesResponse]
readsPrec :: Int -> ReadS DescribeTrustedAdvisorCheckRefreshStatusesResponse
$creadsPrec :: Int -> ReadS DescribeTrustedAdvisorCheckRefreshStatusesResponse
Prelude.Read, Int -> DescribeTrustedAdvisorCheckRefreshStatusesResponse -> ShowS
[DescribeTrustedAdvisorCheckRefreshStatusesResponse] -> ShowS
DescribeTrustedAdvisorCheckRefreshStatusesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeTrustedAdvisorCheckRefreshStatusesResponse] -> ShowS
$cshowList :: [DescribeTrustedAdvisorCheckRefreshStatusesResponse] -> ShowS
show :: DescribeTrustedAdvisorCheckRefreshStatusesResponse -> String
$cshow :: DescribeTrustedAdvisorCheckRefreshStatusesResponse -> String
showsPrec :: Int -> DescribeTrustedAdvisorCheckRefreshStatusesResponse -> ShowS
$cshowsPrec :: Int -> DescribeTrustedAdvisorCheckRefreshStatusesResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeTrustedAdvisorCheckRefreshStatusesResponse x
-> DescribeTrustedAdvisorCheckRefreshStatusesResponse
forall x.
DescribeTrustedAdvisorCheckRefreshStatusesResponse
-> Rep DescribeTrustedAdvisorCheckRefreshStatusesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeTrustedAdvisorCheckRefreshStatusesResponse x
-> DescribeTrustedAdvisorCheckRefreshStatusesResponse
$cfrom :: forall x.
DescribeTrustedAdvisorCheckRefreshStatusesResponse
-> Rep DescribeTrustedAdvisorCheckRefreshStatusesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeTrustedAdvisorCheckRefreshStatusesResponse' 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', 'describeTrustedAdvisorCheckRefreshStatusesResponse_httpStatus' - The response's http status code.
--
-- 'statuses', 'describeTrustedAdvisorCheckRefreshStatusesResponse_statuses' - The refresh status of the specified Trusted Advisor checks.
newDescribeTrustedAdvisorCheckRefreshStatusesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeTrustedAdvisorCheckRefreshStatusesResponse
newDescribeTrustedAdvisorCheckRefreshStatusesResponse :: Int -> DescribeTrustedAdvisorCheckRefreshStatusesResponse
newDescribeTrustedAdvisorCheckRefreshStatusesResponse
  Int
pHttpStatus_ =
    DescribeTrustedAdvisorCheckRefreshStatusesResponse'
      { $sel:httpStatus:DescribeTrustedAdvisorCheckRefreshStatusesResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:statuses:DescribeTrustedAdvisorCheckRefreshStatusesResponse' :: [TrustedAdvisorCheckRefreshStatus]
statuses =
          forall a. Monoid a => a
Prelude.mempty
      }

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

-- | The refresh status of the specified Trusted Advisor checks.
describeTrustedAdvisorCheckRefreshStatusesResponse_statuses :: Lens.Lens' DescribeTrustedAdvisorCheckRefreshStatusesResponse [TrustedAdvisorCheckRefreshStatus]
describeTrustedAdvisorCheckRefreshStatusesResponse_statuses :: Lens'
  DescribeTrustedAdvisorCheckRefreshStatusesResponse
  [TrustedAdvisorCheckRefreshStatus]
describeTrustedAdvisorCheckRefreshStatusesResponse_statuses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTrustedAdvisorCheckRefreshStatusesResponse' {[TrustedAdvisorCheckRefreshStatus]
statuses :: [TrustedAdvisorCheckRefreshStatus]
$sel:statuses:DescribeTrustedAdvisorCheckRefreshStatusesResponse' :: DescribeTrustedAdvisorCheckRefreshStatusesResponse
-> [TrustedAdvisorCheckRefreshStatus]
statuses} -> [TrustedAdvisorCheckRefreshStatus]
statuses) (\s :: DescribeTrustedAdvisorCheckRefreshStatusesResponse
s@DescribeTrustedAdvisorCheckRefreshStatusesResponse' {} [TrustedAdvisorCheckRefreshStatus]
a -> DescribeTrustedAdvisorCheckRefreshStatusesResponse
s {$sel:statuses:DescribeTrustedAdvisorCheckRefreshStatusesResponse' :: [TrustedAdvisorCheckRefreshStatus]
statuses = [TrustedAdvisorCheckRefreshStatus]
a} :: DescribeTrustedAdvisorCheckRefreshStatusesResponse) 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

instance
  Prelude.NFData
    DescribeTrustedAdvisorCheckRefreshStatusesResponse
  where
  rnf :: DescribeTrustedAdvisorCheckRefreshStatusesResponse -> ()
rnf
    DescribeTrustedAdvisorCheckRefreshStatusesResponse' {Int
[TrustedAdvisorCheckRefreshStatus]
statuses :: [TrustedAdvisorCheckRefreshStatus]
httpStatus :: Int
$sel:statuses:DescribeTrustedAdvisorCheckRefreshStatusesResponse' :: DescribeTrustedAdvisorCheckRefreshStatusesResponse
-> [TrustedAdvisorCheckRefreshStatus]
$sel:httpStatus:DescribeTrustedAdvisorCheckRefreshStatusesResponse' :: DescribeTrustedAdvisorCheckRefreshStatusesResponse -> 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 [TrustedAdvisorCheckRefreshStatus]
statuses