{-# 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.AccessAnalyzer.UpdateFindings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the status for the specified findings.
module Amazonka.AccessAnalyzer.UpdateFindings
  ( -- * Creating a Request
    UpdateFindings (..),
    newUpdateFindings,

    -- * Request Lenses
    updateFindings_clientToken,
    updateFindings_ids,
    updateFindings_resourceArn,
    updateFindings_analyzerArn,
    updateFindings_status,

    -- * Destructuring the Response
    UpdateFindingsResponse (..),
    newUpdateFindingsResponse,
  )
where

import Amazonka.AccessAnalyzer.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

-- | Updates findings with the new values provided in the request.
--
-- /See:/ 'newUpdateFindings' smart constructor.
data UpdateFindings = UpdateFindings'
  { -- | A client token.
    UpdateFindings -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The IDs of the findings to update.
    UpdateFindings -> Maybe [Text]
ids :: Prelude.Maybe [Prelude.Text],
    -- | The ARN of the resource identified in the finding.
    UpdateFindings -> Maybe Text
resourceArn :: Prelude.Maybe Prelude.Text,
    -- | The
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the analyzer>
    -- that generated the findings to update.
    UpdateFindings -> Text
analyzerArn :: Prelude.Text,
    -- | The state represents the action to take to update the finding Status.
    -- Use @ARCHIVE@ to change an Active finding to an Archived finding. Use
    -- @ACTIVE@ to change an Archived finding to an Active finding.
    UpdateFindings -> FindingStatusUpdate
status :: FindingStatusUpdate
  }
  deriving (UpdateFindings -> UpdateFindings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFindings -> UpdateFindings -> Bool
$c/= :: UpdateFindings -> UpdateFindings -> Bool
== :: UpdateFindings -> UpdateFindings -> Bool
$c== :: UpdateFindings -> UpdateFindings -> Bool
Prelude.Eq, ReadPrec [UpdateFindings]
ReadPrec UpdateFindings
Int -> ReadS UpdateFindings
ReadS [UpdateFindings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFindings]
$creadListPrec :: ReadPrec [UpdateFindings]
readPrec :: ReadPrec UpdateFindings
$creadPrec :: ReadPrec UpdateFindings
readList :: ReadS [UpdateFindings]
$creadList :: ReadS [UpdateFindings]
readsPrec :: Int -> ReadS UpdateFindings
$creadsPrec :: Int -> ReadS UpdateFindings
Prelude.Read, Int -> UpdateFindings -> ShowS
[UpdateFindings] -> ShowS
UpdateFindings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFindings] -> ShowS
$cshowList :: [UpdateFindings] -> ShowS
show :: UpdateFindings -> String
$cshow :: UpdateFindings -> String
showsPrec :: Int -> UpdateFindings -> ShowS
$cshowsPrec :: Int -> UpdateFindings -> ShowS
Prelude.Show, forall x. Rep UpdateFindings x -> UpdateFindings
forall x. UpdateFindings -> Rep UpdateFindings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFindings x -> UpdateFindings
$cfrom :: forall x. UpdateFindings -> Rep UpdateFindings x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFindings' 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:
--
-- 'clientToken', 'updateFindings_clientToken' - A client token.
--
-- 'ids', 'updateFindings_ids' - The IDs of the findings to update.
--
-- 'resourceArn', 'updateFindings_resourceArn' - The ARN of the resource identified in the finding.
--
-- 'analyzerArn', 'updateFindings_analyzerArn' - The
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the analyzer>
-- that generated the findings to update.
--
-- 'status', 'updateFindings_status' - The state represents the action to take to update the finding Status.
-- Use @ARCHIVE@ to change an Active finding to an Archived finding. Use
-- @ACTIVE@ to change an Archived finding to an Active finding.
newUpdateFindings ::
  -- | 'analyzerArn'
  Prelude.Text ->
  -- | 'status'
  FindingStatusUpdate ->
  UpdateFindings
newUpdateFindings :: Text -> FindingStatusUpdate -> UpdateFindings
newUpdateFindings Text
pAnalyzerArn_ FindingStatusUpdate
pStatus_ =
  UpdateFindings'
    { $sel:clientToken:UpdateFindings' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:ids:UpdateFindings' :: Maybe [Text]
ids = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceArn:UpdateFindings' :: Maybe Text
resourceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:analyzerArn:UpdateFindings' :: Text
analyzerArn = Text
pAnalyzerArn_,
      $sel:status:UpdateFindings' :: FindingStatusUpdate
status = FindingStatusUpdate
pStatus_
    }

-- | A client token.
updateFindings_clientToken :: Lens.Lens' UpdateFindings (Prelude.Maybe Prelude.Text)
updateFindings_clientToken :: Lens' UpdateFindings (Maybe Text)
updateFindings_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindings' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:UpdateFindings' :: UpdateFindings -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: UpdateFindings
s@UpdateFindings' {} Maybe Text
a -> UpdateFindings
s {$sel:clientToken:UpdateFindings' :: Maybe Text
clientToken = Maybe Text
a} :: UpdateFindings)

-- | The IDs of the findings to update.
updateFindings_ids :: Lens.Lens' UpdateFindings (Prelude.Maybe [Prelude.Text])
updateFindings_ids :: Lens' UpdateFindings (Maybe [Text])
updateFindings_ids = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindings' {Maybe [Text]
ids :: Maybe [Text]
$sel:ids:UpdateFindings' :: UpdateFindings -> Maybe [Text]
ids} -> Maybe [Text]
ids) (\s :: UpdateFindings
s@UpdateFindings' {} Maybe [Text]
a -> UpdateFindings
s {$sel:ids:UpdateFindings' :: Maybe [Text]
ids = Maybe [Text]
a} :: UpdateFindings) 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 ARN of the resource identified in the finding.
updateFindings_resourceArn :: Lens.Lens' UpdateFindings (Prelude.Maybe Prelude.Text)
updateFindings_resourceArn :: Lens' UpdateFindings (Maybe Text)
updateFindings_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindings' {Maybe Text
resourceArn :: Maybe Text
$sel:resourceArn:UpdateFindings' :: UpdateFindings -> Maybe Text
resourceArn} -> Maybe Text
resourceArn) (\s :: UpdateFindings
s@UpdateFindings' {} Maybe Text
a -> UpdateFindings
s {$sel:resourceArn:UpdateFindings' :: Maybe Text
resourceArn = Maybe Text
a} :: UpdateFindings)

-- | The
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the analyzer>
-- that generated the findings to update.
updateFindings_analyzerArn :: Lens.Lens' UpdateFindings Prelude.Text
updateFindings_analyzerArn :: Lens' UpdateFindings Text
updateFindings_analyzerArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindings' {Text
analyzerArn :: Text
$sel:analyzerArn:UpdateFindings' :: UpdateFindings -> Text
analyzerArn} -> Text
analyzerArn) (\s :: UpdateFindings
s@UpdateFindings' {} Text
a -> UpdateFindings
s {$sel:analyzerArn:UpdateFindings' :: Text
analyzerArn = Text
a} :: UpdateFindings)

-- | The state represents the action to take to update the finding Status.
-- Use @ARCHIVE@ to change an Active finding to an Archived finding. Use
-- @ACTIVE@ to change an Archived finding to an Active finding.
updateFindings_status :: Lens.Lens' UpdateFindings FindingStatusUpdate
updateFindings_status :: Lens' UpdateFindings FindingStatusUpdate
updateFindings_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindings' {FindingStatusUpdate
status :: FindingStatusUpdate
$sel:status:UpdateFindings' :: UpdateFindings -> FindingStatusUpdate
status} -> FindingStatusUpdate
status) (\s :: UpdateFindings
s@UpdateFindings' {} FindingStatusUpdate
a -> UpdateFindings
s {$sel:status:UpdateFindings' :: FindingStatusUpdate
status = FindingStatusUpdate
a} :: UpdateFindings)

instance Core.AWSRequest UpdateFindings where
  type
    AWSResponse UpdateFindings =
      UpdateFindingsResponse
  request :: (Service -> Service) -> UpdateFindings -> Request UpdateFindings
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateFindings
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateFindings)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UpdateFindingsResponse
UpdateFindingsResponse'

instance Prelude.Hashable UpdateFindings where
  hashWithSalt :: Int -> UpdateFindings -> Int
hashWithSalt Int
_salt UpdateFindings' {Maybe [Text]
Maybe Text
Text
FindingStatusUpdate
status :: FindingStatusUpdate
analyzerArn :: Text
resourceArn :: Maybe Text
ids :: Maybe [Text]
clientToken :: Maybe Text
$sel:status:UpdateFindings' :: UpdateFindings -> FindingStatusUpdate
$sel:analyzerArn:UpdateFindings' :: UpdateFindings -> Text
$sel:resourceArn:UpdateFindings' :: UpdateFindings -> Maybe Text
$sel:ids:UpdateFindings' :: UpdateFindings -> Maybe [Text]
$sel:clientToken:UpdateFindings' :: UpdateFindings -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
ids
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resourceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
analyzerArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FindingStatusUpdate
status

instance Prelude.NFData UpdateFindings where
  rnf :: UpdateFindings -> ()
rnf UpdateFindings' {Maybe [Text]
Maybe Text
Text
FindingStatusUpdate
status :: FindingStatusUpdate
analyzerArn :: Text
resourceArn :: Maybe Text
ids :: Maybe [Text]
clientToken :: Maybe Text
$sel:status:UpdateFindings' :: UpdateFindings -> FindingStatusUpdate
$sel:analyzerArn:UpdateFindings' :: UpdateFindings -> Text
$sel:resourceArn:UpdateFindings' :: UpdateFindings -> Maybe Text
$sel:ids:UpdateFindings' :: UpdateFindings -> Maybe [Text]
$sel:clientToken:UpdateFindings' :: UpdateFindings -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
ids
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
analyzerArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FindingStatusUpdate
status

instance Data.ToHeaders UpdateFindings where
  toHeaders :: UpdateFindings -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateFindings where
  toJSON :: UpdateFindings -> Value
toJSON UpdateFindings' {Maybe [Text]
Maybe Text
Text
FindingStatusUpdate
status :: FindingStatusUpdate
analyzerArn :: Text
resourceArn :: Maybe Text
ids :: Maybe [Text]
clientToken :: Maybe Text
$sel:status:UpdateFindings' :: UpdateFindings -> FindingStatusUpdate
$sel:analyzerArn:UpdateFindings' :: UpdateFindings -> Text
$sel:resourceArn:UpdateFindings' :: UpdateFindings -> Maybe Text
$sel:ids:UpdateFindings' :: UpdateFindings -> Maybe [Text]
$sel:clientToken:UpdateFindings' :: UpdateFindings -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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 Text
clientToken,
            (Key
"ids" 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 [Text]
ids,
            (Key
"resourceArn" 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 Text
resourceArn,
            forall a. a -> Maybe a
Prelude.Just (Key
"analyzerArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
analyzerArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= FindingStatusUpdate
status)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateFindingsResponse' 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.
newUpdateFindingsResponse ::
  UpdateFindingsResponse
newUpdateFindingsResponse :: UpdateFindingsResponse
newUpdateFindingsResponse = UpdateFindingsResponse
UpdateFindingsResponse'

instance Prelude.NFData UpdateFindingsResponse where
  rnf :: UpdateFindingsResponse -> ()
rnf UpdateFindingsResponse
_ = ()