{-# 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.Config.StartConfigRulesEvaluation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Runs an on-demand evaluation for the specified Config rules against the
-- last known configuration state of the resources. Use
-- @StartConfigRulesEvaluation@ when you want to test that a rule you
-- updated is working as expected. @StartConfigRulesEvaluation@ does not
-- re-record the latest configuration state for your resources. It re-runs
-- an evaluation against the last known state of your resources.
--
-- You can specify up to 25 Config rules per request.
--
-- An existing @StartConfigRulesEvaluation@ call for the specified rules
-- must complete before you can call the API again. If you chose to have
-- Config stream to an Amazon SNS topic, you will receive a
-- @ConfigRuleEvaluationStarted@ notification when the evaluation starts.
--
-- You don\'t need to call the @StartConfigRulesEvaluation@ API to run an
-- evaluation for a new rule. When you create a rule, Config evaluates your
-- resources against the rule automatically.
--
-- The @StartConfigRulesEvaluation@ API is useful if you want to run
-- on-demand evaluations, such as the following example:
--
-- 1.  You have a custom rule that evaluates your IAM resources every 24
--     hours.
--
-- 2.  You update your Lambda function to add additional conditions to your
--     rule.
--
-- 3.  Instead of waiting for the next periodic evaluation, you call the
--     @StartConfigRulesEvaluation@ API.
--
-- 4.  Config invokes your Lambda function and evaluates your IAM
--     resources.
--
-- 5.  Your custom rule will still run periodic evaluations every 24 hours.
module Amazonka.Config.StartConfigRulesEvaluation
  ( -- * Creating a Request
    StartConfigRulesEvaluation (..),
    newStartConfigRulesEvaluation,

    -- * Request Lenses
    startConfigRulesEvaluation_configRuleNames,

    -- * Destructuring the Response
    StartConfigRulesEvaluationResponse (..),
    newStartConfigRulesEvaluationResponse,

    -- * Response Lenses
    startConfigRulesEvaluationResponse_httpStatus,
  )
where

import Amazonka.Config.Types
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

-- |
--
-- /See:/ 'newStartConfigRulesEvaluation' smart constructor.
data StartConfigRulesEvaluation = StartConfigRulesEvaluation'
  { -- | The list of names of Config rules that you want to run evaluations for.
    StartConfigRulesEvaluation -> Maybe (NonEmpty Text)
configRuleNames :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text)
  }
  deriving (StartConfigRulesEvaluation -> StartConfigRulesEvaluation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartConfigRulesEvaluation -> StartConfigRulesEvaluation -> Bool
$c/= :: StartConfigRulesEvaluation -> StartConfigRulesEvaluation -> Bool
== :: StartConfigRulesEvaluation -> StartConfigRulesEvaluation -> Bool
$c== :: StartConfigRulesEvaluation -> StartConfigRulesEvaluation -> Bool
Prelude.Eq, ReadPrec [StartConfigRulesEvaluation]
ReadPrec StartConfigRulesEvaluation
Int -> ReadS StartConfigRulesEvaluation
ReadS [StartConfigRulesEvaluation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartConfigRulesEvaluation]
$creadListPrec :: ReadPrec [StartConfigRulesEvaluation]
readPrec :: ReadPrec StartConfigRulesEvaluation
$creadPrec :: ReadPrec StartConfigRulesEvaluation
readList :: ReadS [StartConfigRulesEvaluation]
$creadList :: ReadS [StartConfigRulesEvaluation]
readsPrec :: Int -> ReadS StartConfigRulesEvaluation
$creadsPrec :: Int -> ReadS StartConfigRulesEvaluation
Prelude.Read, Int -> StartConfigRulesEvaluation -> ShowS
[StartConfigRulesEvaluation] -> ShowS
StartConfigRulesEvaluation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartConfigRulesEvaluation] -> ShowS
$cshowList :: [StartConfigRulesEvaluation] -> ShowS
show :: StartConfigRulesEvaluation -> String
$cshow :: StartConfigRulesEvaluation -> String
showsPrec :: Int -> StartConfigRulesEvaluation -> ShowS
$cshowsPrec :: Int -> StartConfigRulesEvaluation -> ShowS
Prelude.Show, forall x.
Rep StartConfigRulesEvaluation x -> StartConfigRulesEvaluation
forall x.
StartConfigRulesEvaluation -> Rep StartConfigRulesEvaluation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartConfigRulesEvaluation x -> StartConfigRulesEvaluation
$cfrom :: forall x.
StartConfigRulesEvaluation -> Rep StartConfigRulesEvaluation x
Prelude.Generic)

-- |
-- Create a value of 'StartConfigRulesEvaluation' 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:
--
-- 'configRuleNames', 'startConfigRulesEvaluation_configRuleNames' - The list of names of Config rules that you want to run evaluations for.
newStartConfigRulesEvaluation ::
  StartConfigRulesEvaluation
newStartConfigRulesEvaluation :: StartConfigRulesEvaluation
newStartConfigRulesEvaluation =
  StartConfigRulesEvaluation'
    { $sel:configRuleNames:StartConfigRulesEvaluation' :: Maybe (NonEmpty Text)
configRuleNames =
        forall a. Maybe a
Prelude.Nothing
    }

-- | The list of names of Config rules that you want to run evaluations for.
startConfigRulesEvaluation_configRuleNames :: Lens.Lens' StartConfigRulesEvaluation (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
startConfigRulesEvaluation_configRuleNames :: Lens' StartConfigRulesEvaluation (Maybe (NonEmpty Text))
startConfigRulesEvaluation_configRuleNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartConfigRulesEvaluation' {Maybe (NonEmpty Text)
configRuleNames :: Maybe (NonEmpty Text)
$sel:configRuleNames:StartConfigRulesEvaluation' :: StartConfigRulesEvaluation -> Maybe (NonEmpty Text)
configRuleNames} -> Maybe (NonEmpty Text)
configRuleNames) (\s :: StartConfigRulesEvaluation
s@StartConfigRulesEvaluation' {} Maybe (NonEmpty Text)
a -> StartConfigRulesEvaluation
s {$sel:configRuleNames:StartConfigRulesEvaluation' :: Maybe (NonEmpty Text)
configRuleNames = Maybe (NonEmpty Text)
a} :: StartConfigRulesEvaluation) 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

instance Core.AWSRequest StartConfigRulesEvaluation where
  type
    AWSResponse StartConfigRulesEvaluation =
      StartConfigRulesEvaluationResponse
  request :: (Service -> Service)
-> StartConfigRulesEvaluation -> Request StartConfigRulesEvaluation
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 StartConfigRulesEvaluation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartConfigRulesEvaluation)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> StartConfigRulesEvaluationResponse
StartConfigRulesEvaluationResponse'
            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))
      )

instance Prelude.Hashable StartConfigRulesEvaluation where
  hashWithSalt :: Int -> StartConfigRulesEvaluation -> Int
hashWithSalt Int
_salt StartConfigRulesEvaluation' {Maybe (NonEmpty Text)
configRuleNames :: Maybe (NonEmpty Text)
$sel:configRuleNames:StartConfigRulesEvaluation' :: StartConfigRulesEvaluation -> Maybe (NonEmpty Text)
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
configRuleNames

instance Prelude.NFData StartConfigRulesEvaluation where
  rnf :: StartConfigRulesEvaluation -> ()
rnf StartConfigRulesEvaluation' {Maybe (NonEmpty Text)
configRuleNames :: Maybe (NonEmpty Text)
$sel:configRuleNames:StartConfigRulesEvaluation' :: StartConfigRulesEvaluation -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
configRuleNames

instance Data.ToHeaders StartConfigRulesEvaluation where
  toHeaders :: StartConfigRulesEvaluation -> 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
"StarlingDoveService.StartConfigRulesEvaluation" ::
                          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 StartConfigRulesEvaluation where
  toJSON :: StartConfigRulesEvaluation -> Value
toJSON StartConfigRulesEvaluation' {Maybe (NonEmpty Text)
configRuleNames :: Maybe (NonEmpty Text)
$sel:configRuleNames:StartConfigRulesEvaluation' :: StartConfigRulesEvaluation -> Maybe (NonEmpty Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ConfigRuleNames" 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 (NonEmpty Text)
configRuleNames
          ]
      )

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

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

-- | The output when you start the evaluation for the specified Config rule.
--
-- /See:/ 'newStartConfigRulesEvaluationResponse' smart constructor.
data StartConfigRulesEvaluationResponse = StartConfigRulesEvaluationResponse'
  { -- | The response's http status code.
    StartConfigRulesEvaluationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartConfigRulesEvaluationResponse
-> StartConfigRulesEvaluationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartConfigRulesEvaluationResponse
-> StartConfigRulesEvaluationResponse -> Bool
$c/= :: StartConfigRulesEvaluationResponse
-> StartConfigRulesEvaluationResponse -> Bool
== :: StartConfigRulesEvaluationResponse
-> StartConfigRulesEvaluationResponse -> Bool
$c== :: StartConfigRulesEvaluationResponse
-> StartConfigRulesEvaluationResponse -> Bool
Prelude.Eq, ReadPrec [StartConfigRulesEvaluationResponse]
ReadPrec StartConfigRulesEvaluationResponse
Int -> ReadS StartConfigRulesEvaluationResponse
ReadS [StartConfigRulesEvaluationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartConfigRulesEvaluationResponse]
$creadListPrec :: ReadPrec [StartConfigRulesEvaluationResponse]
readPrec :: ReadPrec StartConfigRulesEvaluationResponse
$creadPrec :: ReadPrec StartConfigRulesEvaluationResponse
readList :: ReadS [StartConfigRulesEvaluationResponse]
$creadList :: ReadS [StartConfigRulesEvaluationResponse]
readsPrec :: Int -> ReadS StartConfigRulesEvaluationResponse
$creadsPrec :: Int -> ReadS StartConfigRulesEvaluationResponse
Prelude.Read, Int -> StartConfigRulesEvaluationResponse -> ShowS
[StartConfigRulesEvaluationResponse] -> ShowS
StartConfigRulesEvaluationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartConfigRulesEvaluationResponse] -> ShowS
$cshowList :: [StartConfigRulesEvaluationResponse] -> ShowS
show :: StartConfigRulesEvaluationResponse -> String
$cshow :: StartConfigRulesEvaluationResponse -> String
showsPrec :: Int -> StartConfigRulesEvaluationResponse -> ShowS
$cshowsPrec :: Int -> StartConfigRulesEvaluationResponse -> ShowS
Prelude.Show, forall x.
Rep StartConfigRulesEvaluationResponse x
-> StartConfigRulesEvaluationResponse
forall x.
StartConfigRulesEvaluationResponse
-> Rep StartConfigRulesEvaluationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartConfigRulesEvaluationResponse x
-> StartConfigRulesEvaluationResponse
$cfrom :: forall x.
StartConfigRulesEvaluationResponse
-> Rep StartConfigRulesEvaluationResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartConfigRulesEvaluationResponse' 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', 'startConfigRulesEvaluationResponse_httpStatus' - The response's http status code.
newStartConfigRulesEvaluationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartConfigRulesEvaluationResponse
newStartConfigRulesEvaluationResponse :: Int -> StartConfigRulesEvaluationResponse
newStartConfigRulesEvaluationResponse Int
pHttpStatus_ =
  StartConfigRulesEvaluationResponse'
    { $sel:httpStatus:StartConfigRulesEvaluationResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance
  Prelude.NFData
    StartConfigRulesEvaluationResponse
  where
  rnf :: StartConfigRulesEvaluationResponse -> ()
rnf StartConfigRulesEvaluationResponse' {Int
httpStatus :: Int
$sel:httpStatus:StartConfigRulesEvaluationResponse' :: StartConfigRulesEvaluationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus