{-# 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.GuardDuty.GetFilter
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the details of the filter specified by the filter name.
module Amazonka.GuardDuty.GetFilter
  ( -- * Creating a Request
    GetFilter (..),
    newGetFilter,

    -- * Request Lenses
    getFilter_detectorId,
    getFilter_filterName,

    -- * Destructuring the Response
    GetFilterResponse (..),
    newGetFilterResponse,

    -- * Response Lenses
    getFilterResponse_description,
    getFilterResponse_rank,
    getFilterResponse_tags,
    getFilterResponse_httpStatus,
    getFilterResponse_name,
    getFilterResponse_action,
    getFilterResponse_findingCriteria,
  )
where

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

-- | /See:/ 'newGetFilter' smart constructor.
data GetFilter = GetFilter'
  { -- | The unique ID of the detector that the filter is associated with.
    GetFilter -> Text
detectorId :: Prelude.Text,
    -- | The name of the filter you want to get.
    GetFilter -> Text
filterName :: Prelude.Text
  }
  deriving (GetFilter -> GetFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFilter -> GetFilter -> Bool
$c/= :: GetFilter -> GetFilter -> Bool
== :: GetFilter -> GetFilter -> Bool
$c== :: GetFilter -> GetFilter -> Bool
Prelude.Eq, ReadPrec [GetFilter]
ReadPrec GetFilter
Int -> ReadS GetFilter
ReadS [GetFilter]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFilter]
$creadListPrec :: ReadPrec [GetFilter]
readPrec :: ReadPrec GetFilter
$creadPrec :: ReadPrec GetFilter
readList :: ReadS [GetFilter]
$creadList :: ReadS [GetFilter]
readsPrec :: Int -> ReadS GetFilter
$creadsPrec :: Int -> ReadS GetFilter
Prelude.Read, Int -> GetFilter -> ShowS
[GetFilter] -> ShowS
GetFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFilter] -> ShowS
$cshowList :: [GetFilter] -> ShowS
show :: GetFilter -> String
$cshow :: GetFilter -> String
showsPrec :: Int -> GetFilter -> ShowS
$cshowsPrec :: Int -> GetFilter -> ShowS
Prelude.Show, forall x. Rep GetFilter x -> GetFilter
forall x. GetFilter -> Rep GetFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFilter x -> GetFilter
$cfrom :: forall x. GetFilter -> Rep GetFilter x
Prelude.Generic)

-- |
-- Create a value of 'GetFilter' 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:
--
-- 'detectorId', 'getFilter_detectorId' - The unique ID of the detector that the filter is associated with.
--
-- 'filterName', 'getFilter_filterName' - The name of the filter you want to get.
newGetFilter ::
  -- | 'detectorId'
  Prelude.Text ->
  -- | 'filterName'
  Prelude.Text ->
  GetFilter
newGetFilter :: Text -> Text -> GetFilter
newGetFilter Text
pDetectorId_ Text
pFilterName_ =
  GetFilter'
    { $sel:detectorId:GetFilter' :: Text
detectorId = Text
pDetectorId_,
      $sel:filterName:GetFilter' :: Text
filterName = Text
pFilterName_
    }

-- | The unique ID of the detector that the filter is associated with.
getFilter_detectorId :: Lens.Lens' GetFilter Prelude.Text
getFilter_detectorId :: Lens' GetFilter Text
getFilter_detectorId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFilter' {Text
detectorId :: Text
$sel:detectorId:GetFilter' :: GetFilter -> Text
detectorId} -> Text
detectorId) (\s :: GetFilter
s@GetFilter' {} Text
a -> GetFilter
s {$sel:detectorId:GetFilter' :: Text
detectorId = Text
a} :: GetFilter)

-- | The name of the filter you want to get.
getFilter_filterName :: Lens.Lens' GetFilter Prelude.Text
getFilter_filterName :: Lens' GetFilter Text
getFilter_filterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFilter' {Text
filterName :: Text
$sel:filterName:GetFilter' :: GetFilter -> Text
filterName} -> Text
filterName) (\s :: GetFilter
s@GetFilter' {} Text
a -> GetFilter
s {$sel:filterName:GetFilter' :: Text
filterName = Text
a} :: GetFilter)

instance Core.AWSRequest GetFilter where
  type AWSResponse GetFilter = GetFilterResponse
  request :: (Service -> Service) -> GetFilter -> Request GetFilter
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetFilter
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetFilter)))
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 Natural
-> Maybe (HashMap Text Text)
-> Int
-> Text
-> FilterAction
-> FindingCriteria
-> GetFilterResponse
GetFilterResponse'
            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
"description")
            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
"rank")
            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
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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))
            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
"name")
            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
"action")
            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
"findingCriteria")
      )

instance Prelude.Hashable GetFilter where
  hashWithSalt :: Int -> GetFilter -> Int
hashWithSalt Int
_salt GetFilter' {Text
filterName :: Text
detectorId :: Text
$sel:filterName:GetFilter' :: GetFilter -> Text
$sel:detectorId:GetFilter' :: GetFilter -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
detectorId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
filterName

instance Prelude.NFData GetFilter where
  rnf :: GetFilter -> ()
rnf GetFilter' {Text
filterName :: Text
detectorId :: Text
$sel:filterName:GetFilter' :: GetFilter -> Text
$sel:detectorId:GetFilter' :: GetFilter -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
detectorId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
filterName

instance Data.ToHeaders GetFilter where
  toHeaders :: GetFilter -> 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.ToPath GetFilter where
  toPath :: GetFilter -> ByteString
toPath GetFilter' {Text
filterName :: Text
detectorId :: Text
$sel:filterName:GetFilter' :: GetFilter -> Text
$sel:detectorId:GetFilter' :: GetFilter -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/detector/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
detectorId,
        ByteString
"/filter/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
filterName
      ]

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

-- | /See:/ 'newGetFilterResponse' smart constructor.
data GetFilterResponse = GetFilterResponse'
  { -- | The description of the filter.
    GetFilterResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Specifies the position of the filter in the list of current filters.
    -- Also specifies the order in which this filter is applied to the
    -- findings.
    GetFilterResponse -> Maybe Natural
rank :: Prelude.Maybe Prelude.Natural,
    -- | The tags of the filter resource.
    GetFilterResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetFilterResponse -> Int
httpStatus :: Prelude.Int,
    -- | The name of the filter.
    GetFilterResponse -> Text
name :: Prelude.Text,
    -- | Specifies the action that is to be applied to the findings that match
    -- the filter.
    GetFilterResponse -> FilterAction
action :: FilterAction,
    -- | Represents the criteria to be used in the filter for querying findings.
    GetFilterResponse -> FindingCriteria
findingCriteria :: FindingCriteria
  }
  deriving (GetFilterResponse -> GetFilterResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFilterResponse -> GetFilterResponse -> Bool
$c/= :: GetFilterResponse -> GetFilterResponse -> Bool
== :: GetFilterResponse -> GetFilterResponse -> Bool
$c== :: GetFilterResponse -> GetFilterResponse -> Bool
Prelude.Eq, ReadPrec [GetFilterResponse]
ReadPrec GetFilterResponse
Int -> ReadS GetFilterResponse
ReadS [GetFilterResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFilterResponse]
$creadListPrec :: ReadPrec [GetFilterResponse]
readPrec :: ReadPrec GetFilterResponse
$creadPrec :: ReadPrec GetFilterResponse
readList :: ReadS [GetFilterResponse]
$creadList :: ReadS [GetFilterResponse]
readsPrec :: Int -> ReadS GetFilterResponse
$creadsPrec :: Int -> ReadS GetFilterResponse
Prelude.Read, Int -> GetFilterResponse -> ShowS
[GetFilterResponse] -> ShowS
GetFilterResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFilterResponse] -> ShowS
$cshowList :: [GetFilterResponse] -> ShowS
show :: GetFilterResponse -> String
$cshow :: GetFilterResponse -> String
showsPrec :: Int -> GetFilterResponse -> ShowS
$cshowsPrec :: Int -> GetFilterResponse -> ShowS
Prelude.Show, forall x. Rep GetFilterResponse x -> GetFilterResponse
forall x. GetFilterResponse -> Rep GetFilterResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFilterResponse x -> GetFilterResponse
$cfrom :: forall x. GetFilterResponse -> Rep GetFilterResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetFilterResponse' 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:
--
-- 'description', 'getFilterResponse_description' - The description of the filter.
--
-- 'rank', 'getFilterResponse_rank' - Specifies the position of the filter in the list of current filters.
-- Also specifies the order in which this filter is applied to the
-- findings.
--
-- 'tags', 'getFilterResponse_tags' - The tags of the filter resource.
--
-- 'httpStatus', 'getFilterResponse_httpStatus' - The response's http status code.
--
-- 'name', 'getFilterResponse_name' - The name of the filter.
--
-- 'action', 'getFilterResponse_action' - Specifies the action that is to be applied to the findings that match
-- the filter.
--
-- 'findingCriteria', 'getFilterResponse_findingCriteria' - Represents the criteria to be used in the filter for querying findings.
newGetFilterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'name'
  Prelude.Text ->
  -- | 'action'
  FilterAction ->
  -- | 'findingCriteria'
  FindingCriteria ->
  GetFilterResponse
newGetFilterResponse :: Int -> Text -> FilterAction -> FindingCriteria -> GetFilterResponse
newGetFilterResponse
  Int
pHttpStatus_
  Text
pName_
  FilterAction
pAction_
  FindingCriteria
pFindingCriteria_ =
    GetFilterResponse'
      { $sel:description:GetFilterResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:rank:GetFilterResponse' :: Maybe Natural
rank = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:GetFilterResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetFilterResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:name:GetFilterResponse' :: Text
name = Text
pName_,
        $sel:action:GetFilterResponse' :: FilterAction
action = FilterAction
pAction_,
        $sel:findingCriteria:GetFilterResponse' :: FindingCriteria
findingCriteria = FindingCriteria
pFindingCriteria_
      }

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

-- | Specifies the position of the filter in the list of current filters.
-- Also specifies the order in which this filter is applied to the
-- findings.
getFilterResponse_rank :: Lens.Lens' GetFilterResponse (Prelude.Maybe Prelude.Natural)
getFilterResponse_rank :: Lens' GetFilterResponse (Maybe Natural)
getFilterResponse_rank = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFilterResponse' {Maybe Natural
rank :: Maybe Natural
$sel:rank:GetFilterResponse' :: GetFilterResponse -> Maybe Natural
rank} -> Maybe Natural
rank) (\s :: GetFilterResponse
s@GetFilterResponse' {} Maybe Natural
a -> GetFilterResponse
s {$sel:rank:GetFilterResponse' :: Maybe Natural
rank = Maybe Natural
a} :: GetFilterResponse)

-- | The tags of the filter resource.
getFilterResponse_tags :: Lens.Lens' GetFilterResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getFilterResponse_tags :: Lens' GetFilterResponse (Maybe (HashMap Text Text))
getFilterResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFilterResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetFilterResponse' :: GetFilterResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetFilterResponse
s@GetFilterResponse' {} Maybe (HashMap Text Text)
a -> GetFilterResponse
s {$sel:tags:GetFilterResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetFilterResponse) 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 response's http status code.
getFilterResponse_httpStatus :: Lens.Lens' GetFilterResponse Prelude.Int
getFilterResponse_httpStatus :: Lens' GetFilterResponse Int
getFilterResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFilterResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetFilterResponse' :: GetFilterResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetFilterResponse
s@GetFilterResponse' {} Int
a -> GetFilterResponse
s {$sel:httpStatus:GetFilterResponse' :: Int
httpStatus = Int
a} :: GetFilterResponse)

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

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

-- | Represents the criteria to be used in the filter for querying findings.
getFilterResponse_findingCriteria :: Lens.Lens' GetFilterResponse FindingCriteria
getFilterResponse_findingCriteria :: Lens' GetFilterResponse FindingCriteria
getFilterResponse_findingCriteria = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFilterResponse' {FindingCriteria
findingCriteria :: FindingCriteria
$sel:findingCriteria:GetFilterResponse' :: GetFilterResponse -> FindingCriteria
findingCriteria} -> FindingCriteria
findingCriteria) (\s :: GetFilterResponse
s@GetFilterResponse' {} FindingCriteria
a -> GetFilterResponse
s {$sel:findingCriteria:GetFilterResponse' :: FindingCriteria
findingCriteria = FindingCriteria
a} :: GetFilterResponse)

instance Prelude.NFData GetFilterResponse where
  rnf :: GetFilterResponse -> ()
rnf GetFilterResponse' {Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Text
FilterAction
FindingCriteria
findingCriteria :: FindingCriteria
action :: FilterAction
name :: Text
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
rank :: Maybe Natural
description :: Maybe Text
$sel:findingCriteria:GetFilterResponse' :: GetFilterResponse -> FindingCriteria
$sel:action:GetFilterResponse' :: GetFilterResponse -> FilterAction
$sel:name:GetFilterResponse' :: GetFilterResponse -> Text
$sel:httpStatus:GetFilterResponse' :: GetFilterResponse -> Int
$sel:tags:GetFilterResponse' :: GetFilterResponse -> Maybe (HashMap Text Text)
$sel:rank:GetFilterResponse' :: GetFilterResponse -> Maybe Natural
$sel:description:GetFilterResponse' :: GetFilterResponse -> Maybe Text
..} =
    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 Natural
rank
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FilterAction
action
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FindingCriteria
findingCriteria