{-# 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.StartRemediationExecution
-- 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 remediation for the specified Config rules against the
-- last known remediation configuration. It runs an execution against the
-- current state of your resources. Remediation execution is asynchronous.
--
-- You can specify up to 100 resource keys per request. An existing
-- StartRemediationExecution call for the specified resource keys must
-- complete before you can call the API again.
module Amazonka.Config.StartRemediationExecution
  ( -- * Creating a Request
    StartRemediationExecution (..),
    newStartRemediationExecution,

    -- * Request Lenses
    startRemediationExecution_configRuleName,
    startRemediationExecution_resourceKeys,

    -- * Destructuring the Response
    StartRemediationExecutionResponse (..),
    newStartRemediationExecutionResponse,

    -- * Response Lenses
    startRemediationExecutionResponse_failedItems,
    startRemediationExecutionResponse_failureMessage,
    startRemediationExecutionResponse_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:/ 'newStartRemediationExecution' smart constructor.
data StartRemediationExecution = StartRemediationExecution'
  { -- | The list of names of Config rules that you want to run remediation
    -- execution for.
    StartRemediationExecution -> Text
configRuleName :: Prelude.Text,
    -- | A list of resource keys to be processed with the current request. Each
    -- element in the list consists of the resource type and resource ID.
    StartRemediationExecution -> NonEmpty ResourceKey
resourceKeys :: Prelude.NonEmpty ResourceKey
  }
  deriving (StartRemediationExecution -> StartRemediationExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartRemediationExecution -> StartRemediationExecution -> Bool
$c/= :: StartRemediationExecution -> StartRemediationExecution -> Bool
== :: StartRemediationExecution -> StartRemediationExecution -> Bool
$c== :: StartRemediationExecution -> StartRemediationExecution -> Bool
Prelude.Eq, ReadPrec [StartRemediationExecution]
ReadPrec StartRemediationExecution
Int -> ReadS StartRemediationExecution
ReadS [StartRemediationExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartRemediationExecution]
$creadListPrec :: ReadPrec [StartRemediationExecution]
readPrec :: ReadPrec StartRemediationExecution
$creadPrec :: ReadPrec StartRemediationExecution
readList :: ReadS [StartRemediationExecution]
$creadList :: ReadS [StartRemediationExecution]
readsPrec :: Int -> ReadS StartRemediationExecution
$creadsPrec :: Int -> ReadS StartRemediationExecution
Prelude.Read, Int -> StartRemediationExecution -> ShowS
[StartRemediationExecution] -> ShowS
StartRemediationExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartRemediationExecution] -> ShowS
$cshowList :: [StartRemediationExecution] -> ShowS
show :: StartRemediationExecution -> String
$cshow :: StartRemediationExecution -> String
showsPrec :: Int -> StartRemediationExecution -> ShowS
$cshowsPrec :: Int -> StartRemediationExecution -> ShowS
Prelude.Show, forall x.
Rep StartRemediationExecution x -> StartRemediationExecution
forall x.
StartRemediationExecution -> Rep StartRemediationExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartRemediationExecution x -> StartRemediationExecution
$cfrom :: forall x.
StartRemediationExecution -> Rep StartRemediationExecution x
Prelude.Generic)

-- |
-- Create a value of 'StartRemediationExecution' 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', 'startRemediationExecution_configRuleName' - The list of names of Config rules that you want to run remediation
-- execution for.
--
-- 'resourceKeys', 'startRemediationExecution_resourceKeys' - A list of resource keys to be processed with the current request. Each
-- element in the list consists of the resource type and resource ID.
newStartRemediationExecution ::
  -- | 'configRuleName'
  Prelude.Text ->
  -- | 'resourceKeys'
  Prelude.NonEmpty ResourceKey ->
  StartRemediationExecution
newStartRemediationExecution :: Text -> NonEmpty ResourceKey -> StartRemediationExecution
newStartRemediationExecution
  Text
pConfigRuleName_
  NonEmpty ResourceKey
pResourceKeys_ =
    StartRemediationExecution'
      { $sel:configRuleName:StartRemediationExecution' :: Text
configRuleName =
          Text
pConfigRuleName_,
        $sel:resourceKeys:StartRemediationExecution' :: NonEmpty ResourceKey
resourceKeys =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty ResourceKey
pResourceKeys_
      }

-- | The list of names of Config rules that you want to run remediation
-- execution for.
startRemediationExecution_configRuleName :: Lens.Lens' StartRemediationExecution Prelude.Text
startRemediationExecution_configRuleName :: Lens' StartRemediationExecution Text
startRemediationExecution_configRuleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRemediationExecution' {Text
configRuleName :: Text
$sel:configRuleName:StartRemediationExecution' :: StartRemediationExecution -> Text
configRuleName} -> Text
configRuleName) (\s :: StartRemediationExecution
s@StartRemediationExecution' {} Text
a -> StartRemediationExecution
s {$sel:configRuleName:StartRemediationExecution' :: Text
configRuleName = Text
a} :: StartRemediationExecution)

-- | A list of resource keys to be processed with the current request. Each
-- element in the list consists of the resource type and resource ID.
startRemediationExecution_resourceKeys :: Lens.Lens' StartRemediationExecution (Prelude.NonEmpty ResourceKey)
startRemediationExecution_resourceKeys :: Lens' StartRemediationExecution (NonEmpty ResourceKey)
startRemediationExecution_resourceKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRemediationExecution' {NonEmpty ResourceKey
resourceKeys :: NonEmpty ResourceKey
$sel:resourceKeys:StartRemediationExecution' :: StartRemediationExecution -> NonEmpty ResourceKey
resourceKeys} -> NonEmpty ResourceKey
resourceKeys) (\s :: StartRemediationExecution
s@StartRemediationExecution' {} NonEmpty ResourceKey
a -> StartRemediationExecution
s {$sel:resourceKeys:StartRemediationExecution' :: NonEmpty ResourceKey
resourceKeys = NonEmpty ResourceKey
a} :: StartRemediationExecution) 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 StartRemediationExecution where
  type
    AWSResponse StartRemediationExecution =
      StartRemediationExecutionResponse
  request :: (Service -> Service)
-> StartRemediationExecution -> Request StartRemediationExecution
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 StartRemediationExecution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartRemediationExecution)))
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 (NonEmpty ResourceKey)
-> Maybe Text -> Int -> StartRemediationExecutionResponse
StartRemediationExecutionResponse'
            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
"FailedItems")
            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
"FailureMessage")
            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 StartRemediationExecution where
  hashWithSalt :: Int -> StartRemediationExecution -> Int
hashWithSalt Int
_salt StartRemediationExecution' {NonEmpty ResourceKey
Text
resourceKeys :: NonEmpty ResourceKey
configRuleName :: Text
$sel:resourceKeys:StartRemediationExecution' :: StartRemediationExecution -> NonEmpty ResourceKey
$sel:configRuleName:StartRemediationExecution' :: StartRemediationExecution -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
configRuleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty ResourceKey
resourceKeys

instance Prelude.NFData StartRemediationExecution where
  rnf :: StartRemediationExecution -> ()
rnf StartRemediationExecution' {NonEmpty ResourceKey
Text
resourceKeys :: NonEmpty ResourceKey
configRuleName :: Text
$sel:resourceKeys:StartRemediationExecution' :: StartRemediationExecution -> NonEmpty ResourceKey
$sel:configRuleName:StartRemediationExecution' :: StartRemediationExecution -> 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 NonEmpty ResourceKey
resourceKeys

instance Data.ToHeaders StartRemediationExecution where
  toHeaders :: StartRemediationExecution -> 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.StartRemediationExecution" ::
                          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 StartRemediationExecution where
  toJSON :: StartRemediationExecution -> Value
toJSON StartRemediationExecution' {NonEmpty ResourceKey
Text
resourceKeys :: NonEmpty ResourceKey
configRuleName :: Text
$sel:resourceKeys:StartRemediationExecution' :: StartRemediationExecution -> NonEmpty ResourceKey
$sel:configRuleName:StartRemediationExecution' :: StartRemediationExecution -> 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
"ResourceKeys" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty ResourceKey
resourceKeys)
          ]
      )

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

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

-- | /See:/ 'newStartRemediationExecutionResponse' smart constructor.
data StartRemediationExecutionResponse = StartRemediationExecutionResponse'
  { -- | For resources that have failed to start execution, the API returns a
    -- resource key object.
    StartRemediationExecutionResponse -> Maybe (NonEmpty ResourceKey)
failedItems :: Prelude.Maybe (Prelude.NonEmpty ResourceKey),
    -- | Returns a failure message. For example, the resource is already
    -- compliant.
    StartRemediationExecutionResponse -> Maybe Text
failureMessage :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartRemediationExecutionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartRemediationExecutionResponse
-> StartRemediationExecutionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartRemediationExecutionResponse
-> StartRemediationExecutionResponse -> Bool
$c/= :: StartRemediationExecutionResponse
-> StartRemediationExecutionResponse -> Bool
== :: StartRemediationExecutionResponse
-> StartRemediationExecutionResponse -> Bool
$c== :: StartRemediationExecutionResponse
-> StartRemediationExecutionResponse -> Bool
Prelude.Eq, ReadPrec [StartRemediationExecutionResponse]
ReadPrec StartRemediationExecutionResponse
Int -> ReadS StartRemediationExecutionResponse
ReadS [StartRemediationExecutionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartRemediationExecutionResponse]
$creadListPrec :: ReadPrec [StartRemediationExecutionResponse]
readPrec :: ReadPrec StartRemediationExecutionResponse
$creadPrec :: ReadPrec StartRemediationExecutionResponse
readList :: ReadS [StartRemediationExecutionResponse]
$creadList :: ReadS [StartRemediationExecutionResponse]
readsPrec :: Int -> ReadS StartRemediationExecutionResponse
$creadsPrec :: Int -> ReadS StartRemediationExecutionResponse
Prelude.Read, Int -> StartRemediationExecutionResponse -> ShowS
[StartRemediationExecutionResponse] -> ShowS
StartRemediationExecutionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartRemediationExecutionResponse] -> ShowS
$cshowList :: [StartRemediationExecutionResponse] -> ShowS
show :: StartRemediationExecutionResponse -> String
$cshow :: StartRemediationExecutionResponse -> String
showsPrec :: Int -> StartRemediationExecutionResponse -> ShowS
$cshowsPrec :: Int -> StartRemediationExecutionResponse -> ShowS
Prelude.Show, forall x.
Rep StartRemediationExecutionResponse x
-> StartRemediationExecutionResponse
forall x.
StartRemediationExecutionResponse
-> Rep StartRemediationExecutionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartRemediationExecutionResponse x
-> StartRemediationExecutionResponse
$cfrom :: forall x.
StartRemediationExecutionResponse
-> Rep StartRemediationExecutionResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartRemediationExecutionResponse' 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:
--
-- 'failedItems', 'startRemediationExecutionResponse_failedItems' - For resources that have failed to start execution, the API returns a
-- resource key object.
--
-- 'failureMessage', 'startRemediationExecutionResponse_failureMessage' - Returns a failure message. For example, the resource is already
-- compliant.
--
-- 'httpStatus', 'startRemediationExecutionResponse_httpStatus' - The response's http status code.
newStartRemediationExecutionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartRemediationExecutionResponse
newStartRemediationExecutionResponse :: Int -> StartRemediationExecutionResponse
newStartRemediationExecutionResponse Int
pHttpStatus_ =
  StartRemediationExecutionResponse'
    { $sel:failedItems:StartRemediationExecutionResponse' :: Maybe (NonEmpty ResourceKey)
failedItems =
        forall a. Maybe a
Prelude.Nothing,
      $sel:failureMessage:StartRemediationExecutionResponse' :: Maybe Text
failureMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartRemediationExecutionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | For resources that have failed to start execution, the API returns a
-- resource key object.
startRemediationExecutionResponse_failedItems :: Lens.Lens' StartRemediationExecutionResponse (Prelude.Maybe (Prelude.NonEmpty ResourceKey))
startRemediationExecutionResponse_failedItems :: Lens'
  StartRemediationExecutionResponse (Maybe (NonEmpty ResourceKey))
startRemediationExecutionResponse_failedItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRemediationExecutionResponse' {Maybe (NonEmpty ResourceKey)
failedItems :: Maybe (NonEmpty ResourceKey)
$sel:failedItems:StartRemediationExecutionResponse' :: StartRemediationExecutionResponse -> Maybe (NonEmpty ResourceKey)
failedItems} -> Maybe (NonEmpty ResourceKey)
failedItems) (\s :: StartRemediationExecutionResponse
s@StartRemediationExecutionResponse' {} Maybe (NonEmpty ResourceKey)
a -> StartRemediationExecutionResponse
s {$sel:failedItems:StartRemediationExecutionResponse' :: Maybe (NonEmpty ResourceKey)
failedItems = Maybe (NonEmpty ResourceKey)
a} :: StartRemediationExecutionResponse) 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

-- | Returns a failure message. For example, the resource is already
-- compliant.
startRemediationExecutionResponse_failureMessage :: Lens.Lens' StartRemediationExecutionResponse (Prelude.Maybe Prelude.Text)
startRemediationExecutionResponse_failureMessage :: Lens' StartRemediationExecutionResponse (Maybe Text)
startRemediationExecutionResponse_failureMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRemediationExecutionResponse' {Maybe Text
failureMessage :: Maybe Text
$sel:failureMessage:StartRemediationExecutionResponse' :: StartRemediationExecutionResponse -> Maybe Text
failureMessage} -> Maybe Text
failureMessage) (\s :: StartRemediationExecutionResponse
s@StartRemediationExecutionResponse' {} Maybe Text
a -> StartRemediationExecutionResponse
s {$sel:failureMessage:StartRemediationExecutionResponse' :: Maybe Text
failureMessage = Maybe Text
a} :: StartRemediationExecutionResponse)

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

instance
  Prelude.NFData
    StartRemediationExecutionResponse
  where
  rnf :: StartRemediationExecutionResponse -> ()
rnf StartRemediationExecutionResponse' {Int
Maybe (NonEmpty ResourceKey)
Maybe Text
httpStatus :: Int
failureMessage :: Maybe Text
failedItems :: Maybe (NonEmpty ResourceKey)
$sel:httpStatus:StartRemediationExecutionResponse' :: StartRemediationExecutionResponse -> Int
$sel:failureMessage:StartRemediationExecutionResponse' :: StartRemediationExecutionResponse -> Maybe Text
$sel:failedItems:StartRemediationExecutionResponse' :: StartRemediationExecutionResponse -> Maybe (NonEmpty ResourceKey)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty ResourceKey)
failedItems
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
failureMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus