{-# 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.MacieV2.UpdateFindingsFilter
-- 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 criteria and other settings for a findings filter.
module Amazonka.MacieV2.UpdateFindingsFilter
  ( -- * Creating a Request
    UpdateFindingsFilter (..),
    newUpdateFindingsFilter,

    -- * Request Lenses
    updateFindingsFilter_action,
    updateFindingsFilter_clientToken,
    updateFindingsFilter_description,
    updateFindingsFilter_findingCriteria,
    updateFindingsFilter_name,
    updateFindingsFilter_position,
    updateFindingsFilter_id,

    -- * Destructuring the Response
    UpdateFindingsFilterResponse (..),
    newUpdateFindingsFilterResponse,

    -- * Response Lenses
    updateFindingsFilterResponse_arn,
    updateFindingsFilterResponse_id,
    updateFindingsFilterResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MacieV2.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateFindingsFilter' smart constructor.
data UpdateFindingsFilter = UpdateFindingsFilter'
  { -- | The action to perform on findings that match the filter criteria
    -- (findingCriteria). Valid values are: ARCHIVE, suppress (automatically
    -- archive) the findings; and, NOOP, don\'t perform any action on the
    -- findings.
    UpdateFindingsFilter -> Maybe FindingsFilterAction
action :: Prelude.Maybe FindingsFilterAction,
    -- | A unique, case-sensitive token that you provide to ensure the
    -- idempotency of the request.
    UpdateFindingsFilter -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A custom description of the filter. The description can contain as many
    -- as 512 characters.
    --
    -- We strongly recommend that you avoid including any sensitive data in the
    -- description of a filter. Other users might be able to see this
    -- description, depending on the actions that they\'re allowed to perform
    -- in Amazon Macie.
    UpdateFindingsFilter -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The criteria to use to filter findings.
    UpdateFindingsFilter -> Maybe FindingCriteria
findingCriteria :: Prelude.Maybe FindingCriteria,
    -- | A custom name for the filter. The name must contain at least 3
    -- characters and can contain as many as 64 characters.
    --
    -- We strongly recommend that you avoid including any sensitive data in the
    -- name of a filter. Other users might be able to see this name, depending
    -- on the actions that they\'re allowed to perform in Amazon Macie.
    UpdateFindingsFilter -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The position of the filter in the list of saved filters on the Amazon
    -- Macie console. This value also determines the order in which the filter
    -- is applied to findings, relative to other filters that are also applied
    -- to the findings.
    UpdateFindingsFilter -> Maybe Int
position :: Prelude.Maybe Prelude.Int,
    -- | The unique identifier for the Amazon Macie resource that the request
    -- applies to.
    UpdateFindingsFilter -> Text
id :: Prelude.Text
  }
  deriving (UpdateFindingsFilter -> UpdateFindingsFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFindingsFilter -> UpdateFindingsFilter -> Bool
$c/= :: UpdateFindingsFilter -> UpdateFindingsFilter -> Bool
== :: UpdateFindingsFilter -> UpdateFindingsFilter -> Bool
$c== :: UpdateFindingsFilter -> UpdateFindingsFilter -> Bool
Prelude.Eq, ReadPrec [UpdateFindingsFilter]
ReadPrec UpdateFindingsFilter
Int -> ReadS UpdateFindingsFilter
ReadS [UpdateFindingsFilter]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFindingsFilter]
$creadListPrec :: ReadPrec [UpdateFindingsFilter]
readPrec :: ReadPrec UpdateFindingsFilter
$creadPrec :: ReadPrec UpdateFindingsFilter
readList :: ReadS [UpdateFindingsFilter]
$creadList :: ReadS [UpdateFindingsFilter]
readsPrec :: Int -> ReadS UpdateFindingsFilter
$creadsPrec :: Int -> ReadS UpdateFindingsFilter
Prelude.Read, Int -> UpdateFindingsFilter -> ShowS
[UpdateFindingsFilter] -> ShowS
UpdateFindingsFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFindingsFilter] -> ShowS
$cshowList :: [UpdateFindingsFilter] -> ShowS
show :: UpdateFindingsFilter -> String
$cshow :: UpdateFindingsFilter -> String
showsPrec :: Int -> UpdateFindingsFilter -> ShowS
$cshowsPrec :: Int -> UpdateFindingsFilter -> ShowS
Prelude.Show, forall x. Rep UpdateFindingsFilter x -> UpdateFindingsFilter
forall x. UpdateFindingsFilter -> Rep UpdateFindingsFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFindingsFilter x -> UpdateFindingsFilter
$cfrom :: forall x. UpdateFindingsFilter -> Rep UpdateFindingsFilter x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFindingsFilter' 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:
--
-- 'action', 'updateFindingsFilter_action' - The action to perform on findings that match the filter criteria
-- (findingCriteria). Valid values are: ARCHIVE, suppress (automatically
-- archive) the findings; and, NOOP, don\'t perform any action on the
-- findings.
--
-- 'clientToken', 'updateFindingsFilter_clientToken' - A unique, case-sensitive token that you provide to ensure the
-- idempotency of the request.
--
-- 'description', 'updateFindingsFilter_description' - A custom description of the filter. The description can contain as many
-- as 512 characters.
--
-- We strongly recommend that you avoid including any sensitive data in the
-- description of a filter. Other users might be able to see this
-- description, depending on the actions that they\'re allowed to perform
-- in Amazon Macie.
--
-- 'findingCriteria', 'updateFindingsFilter_findingCriteria' - The criteria to use to filter findings.
--
-- 'name', 'updateFindingsFilter_name' - A custom name for the filter. The name must contain at least 3
-- characters and can contain as many as 64 characters.
--
-- We strongly recommend that you avoid including any sensitive data in the
-- name of a filter. Other users might be able to see this name, depending
-- on the actions that they\'re allowed to perform in Amazon Macie.
--
-- 'position', 'updateFindingsFilter_position' - The position of the filter in the list of saved filters on the Amazon
-- Macie console. This value also determines the order in which the filter
-- is applied to findings, relative to other filters that are also applied
-- to the findings.
--
-- 'id', 'updateFindingsFilter_id' - The unique identifier for the Amazon Macie resource that the request
-- applies to.
newUpdateFindingsFilter ::
  -- | 'id'
  Prelude.Text ->
  UpdateFindingsFilter
newUpdateFindingsFilter :: Text -> UpdateFindingsFilter
newUpdateFindingsFilter Text
pId_ =
  UpdateFindingsFilter'
    { $sel:action:UpdateFindingsFilter' :: Maybe FindingsFilterAction
action = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:UpdateFindingsFilter' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateFindingsFilter' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:findingCriteria:UpdateFindingsFilter' :: Maybe FindingCriteria
findingCriteria = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateFindingsFilter' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:position:UpdateFindingsFilter' :: Maybe Int
position = forall a. Maybe a
Prelude.Nothing,
      $sel:id:UpdateFindingsFilter' :: Text
id = Text
pId_
    }

-- | The action to perform on findings that match the filter criteria
-- (findingCriteria). Valid values are: ARCHIVE, suppress (automatically
-- archive) the findings; and, NOOP, don\'t perform any action on the
-- findings.
updateFindingsFilter_action :: Lens.Lens' UpdateFindingsFilter (Prelude.Maybe FindingsFilterAction)
updateFindingsFilter_action :: Lens' UpdateFindingsFilter (Maybe FindingsFilterAction)
updateFindingsFilter_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindingsFilter' {Maybe FindingsFilterAction
action :: Maybe FindingsFilterAction
$sel:action:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe FindingsFilterAction
action} -> Maybe FindingsFilterAction
action) (\s :: UpdateFindingsFilter
s@UpdateFindingsFilter' {} Maybe FindingsFilterAction
a -> UpdateFindingsFilter
s {$sel:action:UpdateFindingsFilter' :: Maybe FindingsFilterAction
action = Maybe FindingsFilterAction
a} :: UpdateFindingsFilter)

-- | A unique, case-sensitive token that you provide to ensure the
-- idempotency of the request.
updateFindingsFilter_clientToken :: Lens.Lens' UpdateFindingsFilter (Prelude.Maybe Prelude.Text)
updateFindingsFilter_clientToken :: Lens' UpdateFindingsFilter (Maybe Text)
updateFindingsFilter_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindingsFilter' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: UpdateFindingsFilter
s@UpdateFindingsFilter' {} Maybe Text
a -> UpdateFindingsFilter
s {$sel:clientToken:UpdateFindingsFilter' :: Maybe Text
clientToken = Maybe Text
a} :: UpdateFindingsFilter)

-- | A custom description of the filter. The description can contain as many
-- as 512 characters.
--
-- We strongly recommend that you avoid including any sensitive data in the
-- description of a filter. Other users might be able to see this
-- description, depending on the actions that they\'re allowed to perform
-- in Amazon Macie.
updateFindingsFilter_description :: Lens.Lens' UpdateFindingsFilter (Prelude.Maybe Prelude.Text)
updateFindingsFilter_description :: Lens' UpdateFindingsFilter (Maybe Text)
updateFindingsFilter_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindingsFilter' {Maybe Text
description :: Maybe Text
$sel:description:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateFindingsFilter
s@UpdateFindingsFilter' {} Maybe Text
a -> UpdateFindingsFilter
s {$sel:description:UpdateFindingsFilter' :: Maybe Text
description = Maybe Text
a} :: UpdateFindingsFilter)

-- | The criteria to use to filter findings.
updateFindingsFilter_findingCriteria :: Lens.Lens' UpdateFindingsFilter (Prelude.Maybe FindingCriteria)
updateFindingsFilter_findingCriteria :: Lens' UpdateFindingsFilter (Maybe FindingCriteria)
updateFindingsFilter_findingCriteria = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindingsFilter' {Maybe FindingCriteria
findingCriteria :: Maybe FindingCriteria
$sel:findingCriteria:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe FindingCriteria
findingCriteria} -> Maybe FindingCriteria
findingCriteria) (\s :: UpdateFindingsFilter
s@UpdateFindingsFilter' {} Maybe FindingCriteria
a -> UpdateFindingsFilter
s {$sel:findingCriteria:UpdateFindingsFilter' :: Maybe FindingCriteria
findingCriteria = Maybe FindingCriteria
a} :: UpdateFindingsFilter)

-- | A custom name for the filter. The name must contain at least 3
-- characters and can contain as many as 64 characters.
--
-- We strongly recommend that you avoid including any sensitive data in the
-- name of a filter. Other users might be able to see this name, depending
-- on the actions that they\'re allowed to perform in Amazon Macie.
updateFindingsFilter_name :: Lens.Lens' UpdateFindingsFilter (Prelude.Maybe Prelude.Text)
updateFindingsFilter_name :: Lens' UpdateFindingsFilter (Maybe Text)
updateFindingsFilter_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindingsFilter' {Maybe Text
name :: Maybe Text
$sel:name:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateFindingsFilter
s@UpdateFindingsFilter' {} Maybe Text
a -> UpdateFindingsFilter
s {$sel:name:UpdateFindingsFilter' :: Maybe Text
name = Maybe Text
a} :: UpdateFindingsFilter)

-- | The position of the filter in the list of saved filters on the Amazon
-- Macie console. This value also determines the order in which the filter
-- is applied to findings, relative to other filters that are also applied
-- to the findings.
updateFindingsFilter_position :: Lens.Lens' UpdateFindingsFilter (Prelude.Maybe Prelude.Int)
updateFindingsFilter_position :: Lens' UpdateFindingsFilter (Maybe Int)
updateFindingsFilter_position = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindingsFilter' {Maybe Int
position :: Maybe Int
$sel:position:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Int
position} -> Maybe Int
position) (\s :: UpdateFindingsFilter
s@UpdateFindingsFilter' {} Maybe Int
a -> UpdateFindingsFilter
s {$sel:position:UpdateFindingsFilter' :: Maybe Int
position = Maybe Int
a} :: UpdateFindingsFilter)

-- | The unique identifier for the Amazon Macie resource that the request
-- applies to.
updateFindingsFilter_id :: Lens.Lens' UpdateFindingsFilter Prelude.Text
updateFindingsFilter_id :: Lens' UpdateFindingsFilter Text
updateFindingsFilter_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindingsFilter' {Text
id :: Text
$sel:id:UpdateFindingsFilter' :: UpdateFindingsFilter -> Text
id} -> Text
id) (\s :: UpdateFindingsFilter
s@UpdateFindingsFilter' {} Text
a -> UpdateFindingsFilter
s {$sel:id:UpdateFindingsFilter' :: Text
id = Text
a} :: UpdateFindingsFilter)

instance Core.AWSRequest UpdateFindingsFilter where
  type
    AWSResponse UpdateFindingsFilter =
      UpdateFindingsFilterResponse
  request :: (Service -> Service)
-> UpdateFindingsFilter -> Request UpdateFindingsFilter
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateFindingsFilter
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateFindingsFilter)))
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 Text -> Maybe Text -> Int -> UpdateFindingsFilterResponse
UpdateFindingsFilterResponse'
            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
"arn")
            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
"id")
            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 UpdateFindingsFilter where
  hashWithSalt :: Int -> UpdateFindingsFilter -> Int
hashWithSalt Int
_salt UpdateFindingsFilter' {Maybe Int
Maybe Text
Maybe FindingCriteria
Maybe FindingsFilterAction
Text
id :: Text
position :: Maybe Int
name :: Maybe Text
findingCriteria :: Maybe FindingCriteria
description :: Maybe Text
clientToken :: Maybe Text
action :: Maybe FindingsFilterAction
$sel:id:UpdateFindingsFilter' :: UpdateFindingsFilter -> Text
$sel:position:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Int
$sel:name:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
$sel:findingCriteria:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe FindingCriteria
$sel:description:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
$sel:clientToken:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
$sel:action:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe FindingsFilterAction
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FindingsFilterAction
action
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FindingCriteria
findingCriteria
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
position
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData UpdateFindingsFilter where
  rnf :: UpdateFindingsFilter -> ()
rnf UpdateFindingsFilter' {Maybe Int
Maybe Text
Maybe FindingCriteria
Maybe FindingsFilterAction
Text
id :: Text
position :: Maybe Int
name :: Maybe Text
findingCriteria :: Maybe FindingCriteria
description :: Maybe Text
clientToken :: Maybe Text
action :: Maybe FindingsFilterAction
$sel:id:UpdateFindingsFilter' :: UpdateFindingsFilter -> Text
$sel:position:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Int
$sel:name:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
$sel:findingCriteria:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe FindingCriteria
$sel:description:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
$sel:clientToken:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
$sel:action:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe FindingsFilterAction
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FindingsFilterAction
action
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FindingCriteria
findingCriteria
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
position
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders UpdateFindingsFilter where
  toHeaders :: UpdateFindingsFilter -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateFindingsFilter where
  toJSON :: UpdateFindingsFilter -> Value
toJSON UpdateFindingsFilter' {Maybe Int
Maybe Text
Maybe FindingCriteria
Maybe FindingsFilterAction
Text
id :: Text
position :: Maybe Int
name :: Maybe Text
findingCriteria :: Maybe FindingCriteria
description :: Maybe Text
clientToken :: Maybe Text
action :: Maybe FindingsFilterAction
$sel:id:UpdateFindingsFilter' :: UpdateFindingsFilter -> Text
$sel:position:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Int
$sel:name:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
$sel:findingCriteria:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe FindingCriteria
$sel:description:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
$sel:clientToken:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
$sel:action:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe FindingsFilterAction
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"action" 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 FindingsFilterAction
action,
            (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
"description" 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
description,
            (Key
"findingCriteria" 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 FindingCriteria
findingCriteria,
            (Key
"name" 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
name,
            (Key
"position" 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 Int
position
          ]
      )

instance Data.ToPath UpdateFindingsFilter where
  toPath :: UpdateFindingsFilter -> ByteString
toPath UpdateFindingsFilter' {Maybe Int
Maybe Text
Maybe FindingCriteria
Maybe FindingsFilterAction
Text
id :: Text
position :: Maybe Int
name :: Maybe Text
findingCriteria :: Maybe FindingCriteria
description :: Maybe Text
clientToken :: Maybe Text
action :: Maybe FindingsFilterAction
$sel:id:UpdateFindingsFilter' :: UpdateFindingsFilter -> Text
$sel:position:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Int
$sel:name:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
$sel:findingCriteria:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe FindingCriteria
$sel:description:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
$sel:clientToken:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe Text
$sel:action:UpdateFindingsFilter' :: UpdateFindingsFilter -> Maybe FindingsFilterAction
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/findingsfilters/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

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

-- | /See:/ 'newUpdateFindingsFilterResponse' smart constructor.
data UpdateFindingsFilterResponse = UpdateFindingsFilterResponse'
  { -- | The Amazon Resource Name (ARN) of the filter that was updated.
    UpdateFindingsFilterResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for the filter that was updated.
    UpdateFindingsFilterResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateFindingsFilterResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateFindingsFilterResponse
-> UpdateFindingsFilterResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFindingsFilterResponse
-> UpdateFindingsFilterResponse -> Bool
$c/= :: UpdateFindingsFilterResponse
-> UpdateFindingsFilterResponse -> Bool
== :: UpdateFindingsFilterResponse
-> UpdateFindingsFilterResponse -> Bool
$c== :: UpdateFindingsFilterResponse
-> UpdateFindingsFilterResponse -> Bool
Prelude.Eq, ReadPrec [UpdateFindingsFilterResponse]
ReadPrec UpdateFindingsFilterResponse
Int -> ReadS UpdateFindingsFilterResponse
ReadS [UpdateFindingsFilterResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFindingsFilterResponse]
$creadListPrec :: ReadPrec [UpdateFindingsFilterResponse]
readPrec :: ReadPrec UpdateFindingsFilterResponse
$creadPrec :: ReadPrec UpdateFindingsFilterResponse
readList :: ReadS [UpdateFindingsFilterResponse]
$creadList :: ReadS [UpdateFindingsFilterResponse]
readsPrec :: Int -> ReadS UpdateFindingsFilterResponse
$creadsPrec :: Int -> ReadS UpdateFindingsFilterResponse
Prelude.Read, Int -> UpdateFindingsFilterResponse -> ShowS
[UpdateFindingsFilterResponse] -> ShowS
UpdateFindingsFilterResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFindingsFilterResponse] -> ShowS
$cshowList :: [UpdateFindingsFilterResponse] -> ShowS
show :: UpdateFindingsFilterResponse -> String
$cshow :: UpdateFindingsFilterResponse -> String
showsPrec :: Int -> UpdateFindingsFilterResponse -> ShowS
$cshowsPrec :: Int -> UpdateFindingsFilterResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateFindingsFilterResponse x -> UpdateFindingsFilterResponse
forall x.
UpdateFindingsFilterResponse -> Rep UpdateFindingsFilterResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateFindingsFilterResponse x -> UpdateFindingsFilterResponse
$cfrom :: forall x.
UpdateFindingsFilterResponse -> Rep UpdateFindingsFilterResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFindingsFilterResponse' 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:
--
-- 'arn', 'updateFindingsFilterResponse_arn' - The Amazon Resource Name (ARN) of the filter that was updated.
--
-- 'id', 'updateFindingsFilterResponse_id' - The unique identifier for the filter that was updated.
--
-- 'httpStatus', 'updateFindingsFilterResponse_httpStatus' - The response's http status code.
newUpdateFindingsFilterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateFindingsFilterResponse
newUpdateFindingsFilterResponse :: Int -> UpdateFindingsFilterResponse
newUpdateFindingsFilterResponse Int
pHttpStatus_ =
  UpdateFindingsFilterResponse'
    { $sel:arn:UpdateFindingsFilterResponse' :: Maybe Text
arn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:id:UpdateFindingsFilterResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateFindingsFilterResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the filter that was updated.
updateFindingsFilterResponse_arn :: Lens.Lens' UpdateFindingsFilterResponse (Prelude.Maybe Prelude.Text)
updateFindingsFilterResponse_arn :: Lens' UpdateFindingsFilterResponse (Maybe Text)
updateFindingsFilterResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindingsFilterResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:UpdateFindingsFilterResponse' :: UpdateFindingsFilterResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: UpdateFindingsFilterResponse
s@UpdateFindingsFilterResponse' {} Maybe Text
a -> UpdateFindingsFilterResponse
s {$sel:arn:UpdateFindingsFilterResponse' :: Maybe Text
arn = Maybe Text
a} :: UpdateFindingsFilterResponse)

-- | The unique identifier for the filter that was updated.
updateFindingsFilterResponse_id :: Lens.Lens' UpdateFindingsFilterResponse (Prelude.Maybe Prelude.Text)
updateFindingsFilterResponse_id :: Lens' UpdateFindingsFilterResponse (Maybe Text)
updateFindingsFilterResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFindingsFilterResponse' {Maybe Text
id :: Maybe Text
$sel:id:UpdateFindingsFilterResponse' :: UpdateFindingsFilterResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: UpdateFindingsFilterResponse
s@UpdateFindingsFilterResponse' {} Maybe Text
a -> UpdateFindingsFilterResponse
s {$sel:id:UpdateFindingsFilterResponse' :: Maybe Text
id = Maybe Text
a} :: UpdateFindingsFilterResponse)

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

instance Prelude.NFData UpdateFindingsFilterResponse where
  rnf :: UpdateFindingsFilterResponse -> ()
rnf UpdateFindingsFilterResponse' {Int
Maybe Text
httpStatus :: Int
id :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:UpdateFindingsFilterResponse' :: UpdateFindingsFilterResponse -> Int
$sel:id:UpdateFindingsFilterResponse' :: UpdateFindingsFilterResponse -> Maybe Text
$sel:arn:UpdateFindingsFilterResponse' :: UpdateFindingsFilterResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus