{-# 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.RefreshTrustedAdvisorCheck
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Refreshes the Trusted Advisor check that you specify using the check ID.
-- You can get the check IDs by calling the DescribeTrustedAdvisorChecks
-- operation.
--
-- Some checks are refreshed automatically. If you call the
-- @RefreshTrustedAdvisorCheck@ operation to refresh them, you might see
-- the @InvalidParameterValue@ error.
--
-- The response contains a TrustedAdvisorCheckRefreshStatus object.
--
-- -   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.RefreshTrustedAdvisorCheck
  ( -- * Creating a Request
    RefreshTrustedAdvisorCheck (..),
    newRefreshTrustedAdvisorCheck,

    -- * Request Lenses
    refreshTrustedAdvisorCheck_checkId,

    -- * Destructuring the Response
    RefreshTrustedAdvisorCheckResponse (..),
    newRefreshTrustedAdvisorCheckResponse,

    -- * Response Lenses
    refreshTrustedAdvisorCheckResponse_httpStatus,
    refreshTrustedAdvisorCheckResponse_status,
  )
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:/ 'newRefreshTrustedAdvisorCheck' smart constructor.
data RefreshTrustedAdvisorCheck = RefreshTrustedAdvisorCheck'
  { -- | The unique identifier for the Trusted Advisor check to refresh.
    --
    -- Specifying the check ID of a check that is automatically refreshed
    -- causes an @InvalidParameterValue@ error.
    RefreshTrustedAdvisorCheck -> Text
checkId :: Prelude.Text
  }
  deriving (RefreshTrustedAdvisorCheck -> RefreshTrustedAdvisorCheck -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RefreshTrustedAdvisorCheck -> RefreshTrustedAdvisorCheck -> Bool
$c/= :: RefreshTrustedAdvisorCheck -> RefreshTrustedAdvisorCheck -> Bool
== :: RefreshTrustedAdvisorCheck -> RefreshTrustedAdvisorCheck -> Bool
$c== :: RefreshTrustedAdvisorCheck -> RefreshTrustedAdvisorCheck -> Bool
Prelude.Eq, ReadPrec [RefreshTrustedAdvisorCheck]
ReadPrec RefreshTrustedAdvisorCheck
Int -> ReadS RefreshTrustedAdvisorCheck
ReadS [RefreshTrustedAdvisorCheck]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RefreshTrustedAdvisorCheck]
$creadListPrec :: ReadPrec [RefreshTrustedAdvisorCheck]
readPrec :: ReadPrec RefreshTrustedAdvisorCheck
$creadPrec :: ReadPrec RefreshTrustedAdvisorCheck
readList :: ReadS [RefreshTrustedAdvisorCheck]
$creadList :: ReadS [RefreshTrustedAdvisorCheck]
readsPrec :: Int -> ReadS RefreshTrustedAdvisorCheck
$creadsPrec :: Int -> ReadS RefreshTrustedAdvisorCheck
Prelude.Read, Int -> RefreshTrustedAdvisorCheck -> ShowS
[RefreshTrustedAdvisorCheck] -> ShowS
RefreshTrustedAdvisorCheck -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RefreshTrustedAdvisorCheck] -> ShowS
$cshowList :: [RefreshTrustedAdvisorCheck] -> ShowS
show :: RefreshTrustedAdvisorCheck -> String
$cshow :: RefreshTrustedAdvisorCheck -> String
showsPrec :: Int -> RefreshTrustedAdvisorCheck -> ShowS
$cshowsPrec :: Int -> RefreshTrustedAdvisorCheck -> ShowS
Prelude.Show, forall x.
Rep RefreshTrustedAdvisorCheck x -> RefreshTrustedAdvisorCheck
forall x.
RefreshTrustedAdvisorCheck -> Rep RefreshTrustedAdvisorCheck x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RefreshTrustedAdvisorCheck x -> RefreshTrustedAdvisorCheck
$cfrom :: forall x.
RefreshTrustedAdvisorCheck -> Rep RefreshTrustedAdvisorCheck x
Prelude.Generic)

-- |
-- Create a value of 'RefreshTrustedAdvisorCheck' 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:
--
-- 'checkId', 'refreshTrustedAdvisorCheck_checkId' - The unique identifier for the Trusted Advisor check to refresh.
--
-- Specifying the check ID of a check that is automatically refreshed
-- causes an @InvalidParameterValue@ error.
newRefreshTrustedAdvisorCheck ::
  -- | 'checkId'
  Prelude.Text ->
  RefreshTrustedAdvisorCheck
newRefreshTrustedAdvisorCheck :: Text -> RefreshTrustedAdvisorCheck
newRefreshTrustedAdvisorCheck Text
pCheckId_ =
  RefreshTrustedAdvisorCheck' {$sel:checkId:RefreshTrustedAdvisorCheck' :: Text
checkId = Text
pCheckId_}

-- | The unique identifier for the Trusted Advisor check to refresh.
--
-- Specifying the check ID of a check that is automatically refreshed
-- causes an @InvalidParameterValue@ error.
refreshTrustedAdvisorCheck_checkId :: Lens.Lens' RefreshTrustedAdvisorCheck Prelude.Text
refreshTrustedAdvisorCheck_checkId :: Lens' RefreshTrustedAdvisorCheck Text
refreshTrustedAdvisorCheck_checkId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RefreshTrustedAdvisorCheck' {Text
checkId :: Text
$sel:checkId:RefreshTrustedAdvisorCheck' :: RefreshTrustedAdvisorCheck -> Text
checkId} -> Text
checkId) (\s :: RefreshTrustedAdvisorCheck
s@RefreshTrustedAdvisorCheck' {} Text
a -> RefreshTrustedAdvisorCheck
s {$sel:checkId:RefreshTrustedAdvisorCheck' :: Text
checkId = Text
a} :: RefreshTrustedAdvisorCheck)

instance Core.AWSRequest RefreshTrustedAdvisorCheck where
  type
    AWSResponse RefreshTrustedAdvisorCheck =
      RefreshTrustedAdvisorCheckResponse
  request :: (Service -> Service)
-> RefreshTrustedAdvisorCheck -> Request RefreshTrustedAdvisorCheck
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 RefreshTrustedAdvisorCheck
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RefreshTrustedAdvisorCheck)))
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
-> RefreshTrustedAdvisorCheckResponse
RefreshTrustedAdvisorCheckResponse'
            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
"status")
      )

instance Prelude.Hashable RefreshTrustedAdvisorCheck where
  hashWithSalt :: Int -> RefreshTrustedAdvisorCheck -> Int
hashWithSalt Int
_salt RefreshTrustedAdvisorCheck' {Text
checkId :: Text
$sel:checkId:RefreshTrustedAdvisorCheck' :: RefreshTrustedAdvisorCheck -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
checkId

instance Prelude.NFData RefreshTrustedAdvisorCheck where
  rnf :: RefreshTrustedAdvisorCheck -> ()
rnf RefreshTrustedAdvisorCheck' {Text
checkId :: Text
$sel:checkId:RefreshTrustedAdvisorCheck' :: RefreshTrustedAdvisorCheck -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
checkId

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

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

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

-- | The current refresh status of a Trusted Advisor check.
--
-- /See:/ 'newRefreshTrustedAdvisorCheckResponse' smart constructor.
data RefreshTrustedAdvisorCheckResponse = RefreshTrustedAdvisorCheckResponse'
  { -- | The response's http status code.
    RefreshTrustedAdvisorCheckResponse -> Int
httpStatus :: Prelude.Int,
    -- | The current refresh status for a check, including the amount of time
    -- until the check is eligible for refresh.
    RefreshTrustedAdvisorCheckResponse
-> TrustedAdvisorCheckRefreshStatus
status :: TrustedAdvisorCheckRefreshStatus
  }
  deriving (RefreshTrustedAdvisorCheckResponse
-> RefreshTrustedAdvisorCheckResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RefreshTrustedAdvisorCheckResponse
-> RefreshTrustedAdvisorCheckResponse -> Bool
$c/= :: RefreshTrustedAdvisorCheckResponse
-> RefreshTrustedAdvisorCheckResponse -> Bool
== :: RefreshTrustedAdvisorCheckResponse
-> RefreshTrustedAdvisorCheckResponse -> Bool
$c== :: RefreshTrustedAdvisorCheckResponse
-> RefreshTrustedAdvisorCheckResponse -> Bool
Prelude.Eq, ReadPrec [RefreshTrustedAdvisorCheckResponse]
ReadPrec RefreshTrustedAdvisorCheckResponse
Int -> ReadS RefreshTrustedAdvisorCheckResponse
ReadS [RefreshTrustedAdvisorCheckResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RefreshTrustedAdvisorCheckResponse]
$creadListPrec :: ReadPrec [RefreshTrustedAdvisorCheckResponse]
readPrec :: ReadPrec RefreshTrustedAdvisorCheckResponse
$creadPrec :: ReadPrec RefreshTrustedAdvisorCheckResponse
readList :: ReadS [RefreshTrustedAdvisorCheckResponse]
$creadList :: ReadS [RefreshTrustedAdvisorCheckResponse]
readsPrec :: Int -> ReadS RefreshTrustedAdvisorCheckResponse
$creadsPrec :: Int -> ReadS RefreshTrustedAdvisorCheckResponse
Prelude.Read, Int -> RefreshTrustedAdvisorCheckResponse -> ShowS
[RefreshTrustedAdvisorCheckResponse] -> ShowS
RefreshTrustedAdvisorCheckResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RefreshTrustedAdvisorCheckResponse] -> ShowS
$cshowList :: [RefreshTrustedAdvisorCheckResponse] -> ShowS
show :: RefreshTrustedAdvisorCheckResponse -> String
$cshow :: RefreshTrustedAdvisorCheckResponse -> String
showsPrec :: Int -> RefreshTrustedAdvisorCheckResponse -> ShowS
$cshowsPrec :: Int -> RefreshTrustedAdvisorCheckResponse -> ShowS
Prelude.Show, forall x.
Rep RefreshTrustedAdvisorCheckResponse x
-> RefreshTrustedAdvisorCheckResponse
forall x.
RefreshTrustedAdvisorCheckResponse
-> Rep RefreshTrustedAdvisorCheckResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RefreshTrustedAdvisorCheckResponse x
-> RefreshTrustedAdvisorCheckResponse
$cfrom :: forall x.
RefreshTrustedAdvisorCheckResponse
-> Rep RefreshTrustedAdvisorCheckResponse x
Prelude.Generic)

-- |
-- Create a value of 'RefreshTrustedAdvisorCheckResponse' 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', 'refreshTrustedAdvisorCheckResponse_httpStatus' - The response's http status code.
--
-- 'status', 'refreshTrustedAdvisorCheckResponse_status' - The current refresh status for a check, including the amount of time
-- until the check is eligible for refresh.
newRefreshTrustedAdvisorCheckResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'status'
  TrustedAdvisorCheckRefreshStatus ->
  RefreshTrustedAdvisorCheckResponse
newRefreshTrustedAdvisorCheckResponse :: Int
-> TrustedAdvisorCheckRefreshStatus
-> RefreshTrustedAdvisorCheckResponse
newRefreshTrustedAdvisorCheckResponse
  Int
pHttpStatus_
  TrustedAdvisorCheckRefreshStatus
pStatus_ =
    RefreshTrustedAdvisorCheckResponse'
      { $sel:httpStatus:RefreshTrustedAdvisorCheckResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:status:RefreshTrustedAdvisorCheckResponse' :: TrustedAdvisorCheckRefreshStatus
status = TrustedAdvisorCheckRefreshStatus
pStatus_
      }

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

-- | The current refresh status for a check, including the amount of time
-- until the check is eligible for refresh.
refreshTrustedAdvisorCheckResponse_status :: Lens.Lens' RefreshTrustedAdvisorCheckResponse TrustedAdvisorCheckRefreshStatus
refreshTrustedAdvisorCheckResponse_status :: Lens'
  RefreshTrustedAdvisorCheckResponse TrustedAdvisorCheckRefreshStatus
refreshTrustedAdvisorCheckResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RefreshTrustedAdvisorCheckResponse' {TrustedAdvisorCheckRefreshStatus
status :: TrustedAdvisorCheckRefreshStatus
$sel:status:RefreshTrustedAdvisorCheckResponse' :: RefreshTrustedAdvisorCheckResponse
-> TrustedAdvisorCheckRefreshStatus
status} -> TrustedAdvisorCheckRefreshStatus
status) (\s :: RefreshTrustedAdvisorCheckResponse
s@RefreshTrustedAdvisorCheckResponse' {} TrustedAdvisorCheckRefreshStatus
a -> RefreshTrustedAdvisorCheckResponse
s {$sel:status:RefreshTrustedAdvisorCheckResponse' :: TrustedAdvisorCheckRefreshStatus
status = TrustedAdvisorCheckRefreshStatus
a} :: RefreshTrustedAdvisorCheckResponse)

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