{-# 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.Inspector2.UpdateFilter
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Specifies the action that is to be applied to the findings that match
-- the filter.
module Amazonka.Inspector2.UpdateFilter
  ( -- * Creating a Request
    UpdateFilter (..),
    newUpdateFilter,

    -- * Request Lenses
    updateFilter_action,
    updateFilter_description,
    updateFilter_filterCriteria,
    updateFilter_name,
    updateFilter_reason,
    updateFilter_filterArn,

    -- * Destructuring the Response
    UpdateFilterResponse (..),
    newUpdateFilterResponse,

    -- * Response Lenses
    updateFilterResponse_httpStatus,
    updateFilterResponse_arn,
  )
where

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

-- | /See:/ 'newUpdateFilter' smart constructor.
data UpdateFilter = UpdateFilter'
  { -- | Specifies the action that is to be applied to the findings that match
    -- the filter.
    UpdateFilter -> Maybe FilterAction
action :: Prelude.Maybe FilterAction,
    -- | A description of the filter.
    UpdateFilter -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Defines the criteria to be update in the filter.
    UpdateFilter -> Maybe FilterCriteria
filterCriteria :: Prelude.Maybe FilterCriteria,
    -- | The name of the filter.
    UpdateFilter -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The reason the filter was updated.
    UpdateFilter -> Maybe Text
reason :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Number (ARN) of the filter to update.
    UpdateFilter -> Text
filterArn :: Prelude.Text
  }
  deriving (UpdateFilter -> UpdateFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFilter -> UpdateFilter -> Bool
$c/= :: UpdateFilter -> UpdateFilter -> Bool
== :: UpdateFilter -> UpdateFilter -> Bool
$c== :: UpdateFilter -> UpdateFilter -> Bool
Prelude.Eq, ReadPrec [UpdateFilter]
ReadPrec UpdateFilter
Int -> ReadS UpdateFilter
ReadS [UpdateFilter]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFilter]
$creadListPrec :: ReadPrec [UpdateFilter]
readPrec :: ReadPrec UpdateFilter
$creadPrec :: ReadPrec UpdateFilter
readList :: ReadS [UpdateFilter]
$creadList :: ReadS [UpdateFilter]
readsPrec :: Int -> ReadS UpdateFilter
$creadsPrec :: Int -> ReadS UpdateFilter
Prelude.Read, Int -> UpdateFilter -> ShowS
[UpdateFilter] -> ShowS
UpdateFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFilter] -> ShowS
$cshowList :: [UpdateFilter] -> ShowS
show :: UpdateFilter -> String
$cshow :: UpdateFilter -> String
showsPrec :: Int -> UpdateFilter -> ShowS
$cshowsPrec :: Int -> UpdateFilter -> ShowS
Prelude.Show, forall x. Rep UpdateFilter x -> UpdateFilter
forall x. UpdateFilter -> Rep UpdateFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFilter x -> UpdateFilter
$cfrom :: forall x. UpdateFilter -> Rep UpdateFilter x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFilter' 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', 'updateFilter_action' - Specifies the action that is to be applied to the findings that match
-- the filter.
--
-- 'description', 'updateFilter_description' - A description of the filter.
--
-- 'filterCriteria', 'updateFilter_filterCriteria' - Defines the criteria to be update in the filter.
--
-- 'name', 'updateFilter_name' - The name of the filter.
--
-- 'reason', 'updateFilter_reason' - The reason the filter was updated.
--
-- 'filterArn', 'updateFilter_filterArn' - The Amazon Resource Number (ARN) of the filter to update.
newUpdateFilter ::
  -- | 'filterArn'
  Prelude.Text ->
  UpdateFilter
newUpdateFilter :: Text -> UpdateFilter
newUpdateFilter Text
pFilterArn_ =
  UpdateFilter'
    { $sel:action:UpdateFilter' :: Maybe FilterAction
action = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateFilter' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:filterCriteria:UpdateFilter' :: Maybe FilterCriteria
filterCriteria = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateFilter' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:reason:UpdateFilter' :: Maybe Text
reason = forall a. Maybe a
Prelude.Nothing,
      $sel:filterArn:UpdateFilter' :: Text
filterArn = Text
pFilterArn_
    }

-- | Specifies the action that is to be applied to the findings that match
-- the filter.
updateFilter_action :: Lens.Lens' UpdateFilter (Prelude.Maybe FilterAction)
updateFilter_action :: Lens' UpdateFilter (Maybe FilterAction)
updateFilter_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFilter' {Maybe FilterAction
action :: Maybe FilterAction
$sel:action:UpdateFilter' :: UpdateFilter -> Maybe FilterAction
action} -> Maybe FilterAction
action) (\s :: UpdateFilter
s@UpdateFilter' {} Maybe FilterAction
a -> UpdateFilter
s {$sel:action:UpdateFilter' :: Maybe FilterAction
action = Maybe FilterAction
a} :: UpdateFilter)

-- | A description of the filter.
updateFilter_description :: Lens.Lens' UpdateFilter (Prelude.Maybe Prelude.Text)
updateFilter_description :: Lens' UpdateFilter (Maybe Text)
updateFilter_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFilter' {Maybe Text
description :: Maybe Text
$sel:description:UpdateFilter' :: UpdateFilter -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateFilter
s@UpdateFilter' {} Maybe Text
a -> UpdateFilter
s {$sel:description:UpdateFilter' :: Maybe Text
description = Maybe Text
a} :: UpdateFilter)

-- | Defines the criteria to be update in the filter.
updateFilter_filterCriteria :: Lens.Lens' UpdateFilter (Prelude.Maybe FilterCriteria)
updateFilter_filterCriteria :: Lens' UpdateFilter (Maybe FilterCriteria)
updateFilter_filterCriteria = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFilter' {Maybe FilterCriteria
filterCriteria :: Maybe FilterCriteria
$sel:filterCriteria:UpdateFilter' :: UpdateFilter -> Maybe FilterCriteria
filterCriteria} -> Maybe FilterCriteria
filterCriteria) (\s :: UpdateFilter
s@UpdateFilter' {} Maybe FilterCriteria
a -> UpdateFilter
s {$sel:filterCriteria:UpdateFilter' :: Maybe FilterCriteria
filterCriteria = Maybe FilterCriteria
a} :: UpdateFilter)

-- | The name of the filter.
updateFilter_name :: Lens.Lens' UpdateFilter (Prelude.Maybe Prelude.Text)
updateFilter_name :: Lens' UpdateFilter (Maybe Text)
updateFilter_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFilter' {Maybe Text
name :: Maybe Text
$sel:name:UpdateFilter' :: UpdateFilter -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateFilter
s@UpdateFilter' {} Maybe Text
a -> UpdateFilter
s {$sel:name:UpdateFilter' :: Maybe Text
name = Maybe Text
a} :: UpdateFilter)

-- | The reason the filter was updated.
updateFilter_reason :: Lens.Lens' UpdateFilter (Prelude.Maybe Prelude.Text)
updateFilter_reason :: Lens' UpdateFilter (Maybe Text)
updateFilter_reason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFilter' {Maybe Text
reason :: Maybe Text
$sel:reason:UpdateFilter' :: UpdateFilter -> Maybe Text
reason} -> Maybe Text
reason) (\s :: UpdateFilter
s@UpdateFilter' {} Maybe Text
a -> UpdateFilter
s {$sel:reason:UpdateFilter' :: Maybe Text
reason = Maybe Text
a} :: UpdateFilter)

-- | The Amazon Resource Number (ARN) of the filter to update.
updateFilter_filterArn :: Lens.Lens' UpdateFilter Prelude.Text
updateFilter_filterArn :: Lens' UpdateFilter Text
updateFilter_filterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFilter' {Text
filterArn :: Text
$sel:filterArn:UpdateFilter' :: UpdateFilter -> Text
filterArn} -> Text
filterArn) (\s :: UpdateFilter
s@UpdateFilter' {} Text
a -> UpdateFilter
s {$sel:filterArn:UpdateFilter' :: Text
filterArn = Text
a} :: UpdateFilter)

instance Core.AWSRequest UpdateFilter where
  type AWSResponse UpdateFilter = UpdateFilterResponse
  request :: (Service -> Service) -> UpdateFilter -> Request UpdateFilter
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 UpdateFilter
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateFilter)))
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 ->
          Int -> Text -> UpdateFilterResponse
UpdateFilterResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"arn")
      )

instance Prelude.Hashable UpdateFilter where
  hashWithSalt :: Int -> UpdateFilter -> Int
hashWithSalt Int
_salt UpdateFilter' {Maybe Text
Maybe FilterAction
Maybe FilterCriteria
Text
filterArn :: Text
reason :: Maybe Text
name :: Maybe Text
filterCriteria :: Maybe FilterCriteria
description :: Maybe Text
action :: Maybe FilterAction
$sel:filterArn:UpdateFilter' :: UpdateFilter -> Text
$sel:reason:UpdateFilter' :: UpdateFilter -> Maybe Text
$sel:name:UpdateFilter' :: UpdateFilter -> Maybe Text
$sel:filterCriteria:UpdateFilter' :: UpdateFilter -> Maybe FilterCriteria
$sel:description:UpdateFilter' :: UpdateFilter -> Maybe Text
$sel:action:UpdateFilter' :: UpdateFilter -> Maybe FilterAction
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FilterAction
action
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FilterCriteria
filterCriteria
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
filterArn

instance Prelude.NFData UpdateFilter where
  rnf :: UpdateFilter -> ()
rnf UpdateFilter' {Maybe Text
Maybe FilterAction
Maybe FilterCriteria
Text
filterArn :: Text
reason :: Maybe Text
name :: Maybe Text
filterCriteria :: Maybe FilterCriteria
description :: Maybe Text
action :: Maybe FilterAction
$sel:filterArn:UpdateFilter' :: UpdateFilter -> Text
$sel:reason:UpdateFilter' :: UpdateFilter -> Maybe Text
$sel:name:UpdateFilter' :: UpdateFilter -> Maybe Text
$sel:filterCriteria:UpdateFilter' :: UpdateFilter -> Maybe FilterCriteria
$sel:description:UpdateFilter' :: UpdateFilter -> Maybe Text
$sel:action:UpdateFilter' :: UpdateFilter -> Maybe FilterAction
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FilterAction
action
      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 FilterCriteria
filterCriteria
      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 Text
reason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
filterArn

instance Data.ToHeaders UpdateFilter where
  toHeaders :: UpdateFilter -> 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 UpdateFilter where
  toJSON :: UpdateFilter -> Value
toJSON UpdateFilter' {Maybe Text
Maybe FilterAction
Maybe FilterCriteria
Text
filterArn :: Text
reason :: Maybe Text
name :: Maybe Text
filterCriteria :: Maybe FilterCriteria
description :: Maybe Text
action :: Maybe FilterAction
$sel:filterArn:UpdateFilter' :: UpdateFilter -> Text
$sel:reason:UpdateFilter' :: UpdateFilter -> Maybe Text
$sel:name:UpdateFilter' :: UpdateFilter -> Maybe Text
$sel:filterCriteria:UpdateFilter' :: UpdateFilter -> Maybe FilterCriteria
$sel:description:UpdateFilter' :: UpdateFilter -> Maybe Text
$sel:action:UpdateFilter' :: UpdateFilter -> Maybe FilterAction
..} =
    [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 FilterAction
action,
            (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
"filterCriteria" 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 FilterCriteria
filterCriteria,
            (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
"reason" 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
reason,
            forall a. a -> Maybe a
Prelude.Just (Key
"filterArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
filterArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateFilterResponse' 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', 'updateFilterResponse_httpStatus' - The response's http status code.
--
-- 'arn', 'updateFilterResponse_arn' - The Amazon Resource Number (ARN) of the successfully updated filter.
newUpdateFilterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'arn'
  Prelude.Text ->
  UpdateFilterResponse
newUpdateFilterResponse :: Int -> Text -> UpdateFilterResponse
newUpdateFilterResponse Int
pHttpStatus_ Text
pArn_ =
  UpdateFilterResponse'
    { $sel:httpStatus:UpdateFilterResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:arn:UpdateFilterResponse' :: Text
arn = Text
pArn_
    }

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

-- | The Amazon Resource Number (ARN) of the successfully updated filter.
updateFilterResponse_arn :: Lens.Lens' UpdateFilterResponse Prelude.Text
updateFilterResponse_arn :: Lens' UpdateFilterResponse Text
updateFilterResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFilterResponse' {Text
arn :: Text
$sel:arn:UpdateFilterResponse' :: UpdateFilterResponse -> Text
arn} -> Text
arn) (\s :: UpdateFilterResponse
s@UpdateFilterResponse' {} Text
a -> UpdateFilterResponse
s {$sel:arn:UpdateFilterResponse' :: Text
arn = Text
a} :: UpdateFilterResponse)

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