{-# 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.PutEvaluations
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Used by an Lambda function to deliver evaluation results to Config. This
-- action is required in every Lambda function that is invoked by an Config
-- rule.
module Amazonka.Config.PutEvaluations
  ( -- * Creating a Request
    PutEvaluations (..),
    newPutEvaluations,

    -- * Request Lenses
    putEvaluations_evaluations,
    putEvaluations_testMode,
    putEvaluations_resultToken,

    -- * Destructuring the Response
    PutEvaluationsResponse (..),
    newPutEvaluationsResponse,

    -- * Response Lenses
    putEvaluationsResponse_failedEvaluations,
    putEvaluationsResponse_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:/ 'newPutEvaluations' smart constructor.
data PutEvaluations = PutEvaluations'
  { -- | The assessments that the Lambda function performs. Each evaluation
    -- identifies an Amazon Web Services resource and indicates whether it
    -- complies with the Config rule that invokes the Lambda function.
    PutEvaluations -> Maybe [Evaluation]
evaluations :: Prelude.Maybe [Evaluation],
    -- | Use this parameter to specify a test run for @PutEvaluations@. You can
    -- verify whether your Lambda function will deliver evaluation results to
    -- Config. No updates occur to your existing evaluations, and evaluation
    -- results are not sent to Config.
    --
    -- When @TestMode@ is @true@, @PutEvaluations@ doesn\'t require a valid
    -- value for the @ResultToken@ parameter, but the value cannot be null.
    PutEvaluations -> Maybe Bool
testMode :: Prelude.Maybe Prelude.Bool,
    -- | An encrypted token that associates an evaluation with an Config rule.
    -- Identifies the rule and the event that triggered the evaluation.
    PutEvaluations -> Text
resultToken :: Prelude.Text
  }
  deriving (PutEvaluations -> PutEvaluations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutEvaluations -> PutEvaluations -> Bool
$c/= :: PutEvaluations -> PutEvaluations -> Bool
== :: PutEvaluations -> PutEvaluations -> Bool
$c== :: PutEvaluations -> PutEvaluations -> Bool
Prelude.Eq, ReadPrec [PutEvaluations]
ReadPrec PutEvaluations
Int -> ReadS PutEvaluations
ReadS [PutEvaluations]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutEvaluations]
$creadListPrec :: ReadPrec [PutEvaluations]
readPrec :: ReadPrec PutEvaluations
$creadPrec :: ReadPrec PutEvaluations
readList :: ReadS [PutEvaluations]
$creadList :: ReadS [PutEvaluations]
readsPrec :: Int -> ReadS PutEvaluations
$creadsPrec :: Int -> ReadS PutEvaluations
Prelude.Read, Int -> PutEvaluations -> ShowS
[PutEvaluations] -> ShowS
PutEvaluations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutEvaluations] -> ShowS
$cshowList :: [PutEvaluations] -> ShowS
show :: PutEvaluations -> String
$cshow :: PutEvaluations -> String
showsPrec :: Int -> PutEvaluations -> ShowS
$cshowsPrec :: Int -> PutEvaluations -> ShowS
Prelude.Show, forall x. Rep PutEvaluations x -> PutEvaluations
forall x. PutEvaluations -> Rep PutEvaluations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutEvaluations x -> PutEvaluations
$cfrom :: forall x. PutEvaluations -> Rep PutEvaluations x
Prelude.Generic)

-- |
-- Create a value of 'PutEvaluations' 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:
--
-- 'evaluations', 'putEvaluations_evaluations' - The assessments that the Lambda function performs. Each evaluation
-- identifies an Amazon Web Services resource and indicates whether it
-- complies with the Config rule that invokes the Lambda function.
--
-- 'testMode', 'putEvaluations_testMode' - Use this parameter to specify a test run for @PutEvaluations@. You can
-- verify whether your Lambda function will deliver evaluation results to
-- Config. No updates occur to your existing evaluations, and evaluation
-- results are not sent to Config.
--
-- When @TestMode@ is @true@, @PutEvaluations@ doesn\'t require a valid
-- value for the @ResultToken@ parameter, but the value cannot be null.
--
-- 'resultToken', 'putEvaluations_resultToken' - An encrypted token that associates an evaluation with an Config rule.
-- Identifies the rule and the event that triggered the evaluation.
newPutEvaluations ::
  -- | 'resultToken'
  Prelude.Text ->
  PutEvaluations
newPutEvaluations :: Text -> PutEvaluations
newPutEvaluations Text
pResultToken_ =
  PutEvaluations'
    { $sel:evaluations:PutEvaluations' :: Maybe [Evaluation]
evaluations = forall a. Maybe a
Prelude.Nothing,
      $sel:testMode:PutEvaluations' :: Maybe Bool
testMode = forall a. Maybe a
Prelude.Nothing,
      $sel:resultToken:PutEvaluations' :: Text
resultToken = Text
pResultToken_
    }

-- | The assessments that the Lambda function performs. Each evaluation
-- identifies an Amazon Web Services resource and indicates whether it
-- complies with the Config rule that invokes the Lambda function.
putEvaluations_evaluations :: Lens.Lens' PutEvaluations (Prelude.Maybe [Evaluation])
putEvaluations_evaluations :: Lens' PutEvaluations (Maybe [Evaluation])
putEvaluations_evaluations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEvaluations' {Maybe [Evaluation]
evaluations :: Maybe [Evaluation]
$sel:evaluations:PutEvaluations' :: PutEvaluations -> Maybe [Evaluation]
evaluations} -> Maybe [Evaluation]
evaluations) (\s :: PutEvaluations
s@PutEvaluations' {} Maybe [Evaluation]
a -> PutEvaluations
s {$sel:evaluations:PutEvaluations' :: Maybe [Evaluation]
evaluations = Maybe [Evaluation]
a} :: PutEvaluations) 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

-- | Use this parameter to specify a test run for @PutEvaluations@. You can
-- verify whether your Lambda function will deliver evaluation results to
-- Config. No updates occur to your existing evaluations, and evaluation
-- results are not sent to Config.
--
-- When @TestMode@ is @true@, @PutEvaluations@ doesn\'t require a valid
-- value for the @ResultToken@ parameter, but the value cannot be null.
putEvaluations_testMode :: Lens.Lens' PutEvaluations (Prelude.Maybe Prelude.Bool)
putEvaluations_testMode :: Lens' PutEvaluations (Maybe Bool)
putEvaluations_testMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEvaluations' {Maybe Bool
testMode :: Maybe Bool
$sel:testMode:PutEvaluations' :: PutEvaluations -> Maybe Bool
testMode} -> Maybe Bool
testMode) (\s :: PutEvaluations
s@PutEvaluations' {} Maybe Bool
a -> PutEvaluations
s {$sel:testMode:PutEvaluations' :: Maybe Bool
testMode = Maybe Bool
a} :: PutEvaluations)

-- | An encrypted token that associates an evaluation with an Config rule.
-- Identifies the rule and the event that triggered the evaluation.
putEvaluations_resultToken :: Lens.Lens' PutEvaluations Prelude.Text
putEvaluations_resultToken :: Lens' PutEvaluations Text
putEvaluations_resultToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEvaluations' {Text
resultToken :: Text
$sel:resultToken:PutEvaluations' :: PutEvaluations -> Text
resultToken} -> Text
resultToken) (\s :: PutEvaluations
s@PutEvaluations' {} Text
a -> PutEvaluations
s {$sel:resultToken:PutEvaluations' :: Text
resultToken = Text
a} :: PutEvaluations)

instance Core.AWSRequest PutEvaluations where
  type
    AWSResponse PutEvaluations =
      PutEvaluationsResponse
  request :: (Service -> Service) -> PutEvaluations -> Request PutEvaluations
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 PutEvaluations
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutEvaluations)))
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 [Evaluation] -> Int -> PutEvaluationsResponse
PutEvaluationsResponse'
            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
"FailedEvaluations"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable PutEvaluations where
  hashWithSalt :: Int -> PutEvaluations -> Int
hashWithSalt Int
_salt PutEvaluations' {Maybe Bool
Maybe [Evaluation]
Text
resultToken :: Text
testMode :: Maybe Bool
evaluations :: Maybe [Evaluation]
$sel:resultToken:PutEvaluations' :: PutEvaluations -> Text
$sel:testMode:PutEvaluations' :: PutEvaluations -> Maybe Bool
$sel:evaluations:PutEvaluations' :: PutEvaluations -> Maybe [Evaluation]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Evaluation]
evaluations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
testMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resultToken

instance Prelude.NFData PutEvaluations where
  rnf :: PutEvaluations -> ()
rnf PutEvaluations' {Maybe Bool
Maybe [Evaluation]
Text
resultToken :: Text
testMode :: Maybe Bool
evaluations :: Maybe [Evaluation]
$sel:resultToken:PutEvaluations' :: PutEvaluations -> Text
$sel:testMode:PutEvaluations' :: PutEvaluations -> Maybe Bool
$sel:evaluations:PutEvaluations' :: PutEvaluations -> Maybe [Evaluation]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Evaluation]
evaluations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
testMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resultToken

instance Data.ToHeaders PutEvaluations where
  toHeaders :: PutEvaluations -> 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.PutEvaluations" ::
                          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 PutEvaluations where
  toJSON :: PutEvaluations -> Value
toJSON PutEvaluations' {Maybe Bool
Maybe [Evaluation]
Text
resultToken :: Text
testMode :: Maybe Bool
evaluations :: Maybe [Evaluation]
$sel:resultToken:PutEvaluations' :: PutEvaluations -> Text
$sel:testMode:PutEvaluations' :: PutEvaluations -> Maybe Bool
$sel:evaluations:PutEvaluations' :: PutEvaluations -> Maybe [Evaluation]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Evaluations" 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 [Evaluation]
evaluations,
            (Key
"TestMode" 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 Bool
testMode,
            forall a. a -> Maybe a
Prelude.Just (Key
"ResultToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resultToken)
          ]
      )

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

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

-- |
--
-- /See:/ 'newPutEvaluationsResponse' smart constructor.
data PutEvaluationsResponse = PutEvaluationsResponse'
  { -- | Requests that failed because of a client or server error.
    PutEvaluationsResponse -> Maybe [Evaluation]
failedEvaluations :: Prelude.Maybe [Evaluation],
    -- | The response's http status code.
    PutEvaluationsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutEvaluationsResponse -> PutEvaluationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutEvaluationsResponse -> PutEvaluationsResponse -> Bool
$c/= :: PutEvaluationsResponse -> PutEvaluationsResponse -> Bool
== :: PutEvaluationsResponse -> PutEvaluationsResponse -> Bool
$c== :: PutEvaluationsResponse -> PutEvaluationsResponse -> Bool
Prelude.Eq, ReadPrec [PutEvaluationsResponse]
ReadPrec PutEvaluationsResponse
Int -> ReadS PutEvaluationsResponse
ReadS [PutEvaluationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutEvaluationsResponse]
$creadListPrec :: ReadPrec [PutEvaluationsResponse]
readPrec :: ReadPrec PutEvaluationsResponse
$creadPrec :: ReadPrec PutEvaluationsResponse
readList :: ReadS [PutEvaluationsResponse]
$creadList :: ReadS [PutEvaluationsResponse]
readsPrec :: Int -> ReadS PutEvaluationsResponse
$creadsPrec :: Int -> ReadS PutEvaluationsResponse
Prelude.Read, Int -> PutEvaluationsResponse -> ShowS
[PutEvaluationsResponse] -> ShowS
PutEvaluationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutEvaluationsResponse] -> ShowS
$cshowList :: [PutEvaluationsResponse] -> ShowS
show :: PutEvaluationsResponse -> String
$cshow :: PutEvaluationsResponse -> String
showsPrec :: Int -> PutEvaluationsResponse -> ShowS
$cshowsPrec :: Int -> PutEvaluationsResponse -> ShowS
Prelude.Show, forall x. Rep PutEvaluationsResponse x -> PutEvaluationsResponse
forall x. PutEvaluationsResponse -> Rep PutEvaluationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutEvaluationsResponse x -> PutEvaluationsResponse
$cfrom :: forall x. PutEvaluationsResponse -> Rep PutEvaluationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutEvaluationsResponse' 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:
--
-- 'failedEvaluations', 'putEvaluationsResponse_failedEvaluations' - Requests that failed because of a client or server error.
--
-- 'httpStatus', 'putEvaluationsResponse_httpStatus' - The response's http status code.
newPutEvaluationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutEvaluationsResponse
newPutEvaluationsResponse :: Int -> PutEvaluationsResponse
newPutEvaluationsResponse Int
pHttpStatus_ =
  PutEvaluationsResponse'
    { $sel:failedEvaluations:PutEvaluationsResponse' :: Maybe [Evaluation]
failedEvaluations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutEvaluationsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Requests that failed because of a client or server error.
putEvaluationsResponse_failedEvaluations :: Lens.Lens' PutEvaluationsResponse (Prelude.Maybe [Evaluation])
putEvaluationsResponse_failedEvaluations :: Lens' PutEvaluationsResponse (Maybe [Evaluation])
putEvaluationsResponse_failedEvaluations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEvaluationsResponse' {Maybe [Evaluation]
failedEvaluations :: Maybe [Evaluation]
$sel:failedEvaluations:PutEvaluationsResponse' :: PutEvaluationsResponse -> Maybe [Evaluation]
failedEvaluations} -> Maybe [Evaluation]
failedEvaluations) (\s :: PutEvaluationsResponse
s@PutEvaluationsResponse' {} Maybe [Evaluation]
a -> PutEvaluationsResponse
s {$sel:failedEvaluations:PutEvaluationsResponse' :: Maybe [Evaluation]
failedEvaluations = Maybe [Evaluation]
a} :: PutEvaluationsResponse) 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

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

instance Prelude.NFData PutEvaluationsResponse where
  rnf :: PutEvaluationsResponse -> ()
rnf PutEvaluationsResponse' {Int
Maybe [Evaluation]
httpStatus :: Int
failedEvaluations :: Maybe [Evaluation]
$sel:httpStatus:PutEvaluationsResponse' :: PutEvaluationsResponse -> Int
$sel:failedEvaluations:PutEvaluationsResponse' :: PutEvaluationsResponse -> Maybe [Evaluation]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Evaluation]
failedEvaluations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus