{-# 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.PutExternalEvaluation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Add or updates the evaluations for process checks. This API checks if
-- the rule is a process check when the name of the Config rule is
-- provided.
module Amazonka.Config.PutExternalEvaluation
  ( -- * Creating a Request
    PutExternalEvaluation (..),
    newPutExternalEvaluation,

    -- * Request Lenses
    putExternalEvaluation_configRuleName,
    putExternalEvaluation_externalEvaluation,

    -- * Destructuring the Response
    PutExternalEvaluationResponse (..),
    newPutExternalEvaluationResponse,

    -- * Response Lenses
    putExternalEvaluationResponse_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:/ 'newPutExternalEvaluation' smart constructor.
data PutExternalEvaluation = PutExternalEvaluation'
  { -- | The name of the Config rule.
    PutExternalEvaluation -> Text
configRuleName :: Prelude.Text,
    -- | An @ExternalEvaluation@ object that provides details about compliance.
    PutExternalEvaluation -> ExternalEvaluation
externalEvaluation :: ExternalEvaluation
  }
  deriving (PutExternalEvaluation -> PutExternalEvaluation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutExternalEvaluation -> PutExternalEvaluation -> Bool
$c/= :: PutExternalEvaluation -> PutExternalEvaluation -> Bool
== :: PutExternalEvaluation -> PutExternalEvaluation -> Bool
$c== :: PutExternalEvaluation -> PutExternalEvaluation -> Bool
Prelude.Eq, ReadPrec [PutExternalEvaluation]
ReadPrec PutExternalEvaluation
Int -> ReadS PutExternalEvaluation
ReadS [PutExternalEvaluation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutExternalEvaluation]
$creadListPrec :: ReadPrec [PutExternalEvaluation]
readPrec :: ReadPrec PutExternalEvaluation
$creadPrec :: ReadPrec PutExternalEvaluation
readList :: ReadS [PutExternalEvaluation]
$creadList :: ReadS [PutExternalEvaluation]
readsPrec :: Int -> ReadS PutExternalEvaluation
$creadsPrec :: Int -> ReadS PutExternalEvaluation
Prelude.Read, Int -> PutExternalEvaluation -> ShowS
[PutExternalEvaluation] -> ShowS
PutExternalEvaluation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutExternalEvaluation] -> ShowS
$cshowList :: [PutExternalEvaluation] -> ShowS
show :: PutExternalEvaluation -> String
$cshow :: PutExternalEvaluation -> String
showsPrec :: Int -> PutExternalEvaluation -> ShowS
$cshowsPrec :: Int -> PutExternalEvaluation -> ShowS
Prelude.Show, forall x. Rep PutExternalEvaluation x -> PutExternalEvaluation
forall x. PutExternalEvaluation -> Rep PutExternalEvaluation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutExternalEvaluation x -> PutExternalEvaluation
$cfrom :: forall x. PutExternalEvaluation -> Rep PutExternalEvaluation x
Prelude.Generic)

-- |
-- Create a value of 'PutExternalEvaluation' 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:
--
-- 'configRuleName', 'putExternalEvaluation_configRuleName' - The name of the Config rule.
--
-- 'externalEvaluation', 'putExternalEvaluation_externalEvaluation' - An @ExternalEvaluation@ object that provides details about compliance.
newPutExternalEvaluation ::
  -- | 'configRuleName'
  Prelude.Text ->
  -- | 'externalEvaluation'
  ExternalEvaluation ->
  PutExternalEvaluation
newPutExternalEvaluation :: Text -> ExternalEvaluation -> PutExternalEvaluation
newPutExternalEvaluation
  Text
pConfigRuleName_
  ExternalEvaluation
pExternalEvaluation_ =
    PutExternalEvaluation'
      { $sel:configRuleName:PutExternalEvaluation' :: Text
configRuleName =
          Text
pConfigRuleName_,
        $sel:externalEvaluation:PutExternalEvaluation' :: ExternalEvaluation
externalEvaluation = ExternalEvaluation
pExternalEvaluation_
      }

-- | The name of the Config rule.
putExternalEvaluation_configRuleName :: Lens.Lens' PutExternalEvaluation Prelude.Text
putExternalEvaluation_configRuleName :: Lens' PutExternalEvaluation Text
putExternalEvaluation_configRuleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutExternalEvaluation' {Text
configRuleName :: Text
$sel:configRuleName:PutExternalEvaluation' :: PutExternalEvaluation -> Text
configRuleName} -> Text
configRuleName) (\s :: PutExternalEvaluation
s@PutExternalEvaluation' {} Text
a -> PutExternalEvaluation
s {$sel:configRuleName:PutExternalEvaluation' :: Text
configRuleName = Text
a} :: PutExternalEvaluation)

-- | An @ExternalEvaluation@ object that provides details about compliance.
putExternalEvaluation_externalEvaluation :: Lens.Lens' PutExternalEvaluation ExternalEvaluation
putExternalEvaluation_externalEvaluation :: Lens' PutExternalEvaluation ExternalEvaluation
putExternalEvaluation_externalEvaluation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutExternalEvaluation' {ExternalEvaluation
externalEvaluation :: ExternalEvaluation
$sel:externalEvaluation:PutExternalEvaluation' :: PutExternalEvaluation -> ExternalEvaluation
externalEvaluation} -> ExternalEvaluation
externalEvaluation) (\s :: PutExternalEvaluation
s@PutExternalEvaluation' {} ExternalEvaluation
a -> PutExternalEvaluation
s {$sel:externalEvaluation:PutExternalEvaluation' :: ExternalEvaluation
externalEvaluation = ExternalEvaluation
a} :: PutExternalEvaluation)

instance Core.AWSRequest PutExternalEvaluation where
  type
    AWSResponse PutExternalEvaluation =
      PutExternalEvaluationResponse
  request :: (Service -> Service)
-> PutExternalEvaluation -> Request PutExternalEvaluation
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 PutExternalEvaluation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutExternalEvaluation)))
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 -> PutExternalEvaluationResponse
PutExternalEvaluationResponse'
            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 PutExternalEvaluation where
  hashWithSalt :: Int -> PutExternalEvaluation -> Int
hashWithSalt Int
_salt PutExternalEvaluation' {Text
ExternalEvaluation
externalEvaluation :: ExternalEvaluation
configRuleName :: Text
$sel:externalEvaluation:PutExternalEvaluation' :: PutExternalEvaluation -> ExternalEvaluation
$sel:configRuleName:PutExternalEvaluation' :: PutExternalEvaluation -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
configRuleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ExternalEvaluation
externalEvaluation

instance Prelude.NFData PutExternalEvaluation where
  rnf :: PutExternalEvaluation -> ()
rnf PutExternalEvaluation' {Text
ExternalEvaluation
externalEvaluation :: ExternalEvaluation
configRuleName :: Text
$sel:externalEvaluation:PutExternalEvaluation' :: PutExternalEvaluation -> ExternalEvaluation
$sel:configRuleName:PutExternalEvaluation' :: PutExternalEvaluation -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
configRuleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ExternalEvaluation
externalEvaluation

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

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

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

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

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

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

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