{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.FindingTypeAggregation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Inspector2.Types.FindingTypeAggregation 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.AggregationFindingType
import Amazonka.Inspector2.Types.AggregationResourceType
import Amazonka.Inspector2.Types.FindingTypeSortBy
import Amazonka.Inspector2.Types.SortOrder
import qualified Amazonka.Prelude as Prelude

-- | The details that define an aggregation based on finding type.
--
-- /See:/ 'newFindingTypeAggregation' smart constructor.
data FindingTypeAggregation = FindingTypeAggregation'
  { -- | The finding type to aggregate.
    FindingTypeAggregation -> Maybe AggregationFindingType
findingType :: Prelude.Maybe AggregationFindingType,
    -- | The resource type to aggregate.
    FindingTypeAggregation -> Maybe AggregationResourceType
resourceType :: Prelude.Maybe AggregationResourceType,
    -- | The value to sort results by.
    FindingTypeAggregation -> Maybe FindingTypeSortBy
sortBy :: Prelude.Maybe FindingTypeSortBy,
    -- | The order to sort results by.
    FindingTypeAggregation -> Maybe SortOrder
sortOrder :: Prelude.Maybe SortOrder
  }
  deriving (FindingTypeAggregation -> FindingTypeAggregation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FindingTypeAggregation -> FindingTypeAggregation -> Bool
$c/= :: FindingTypeAggregation -> FindingTypeAggregation -> Bool
== :: FindingTypeAggregation -> FindingTypeAggregation -> Bool
$c== :: FindingTypeAggregation -> FindingTypeAggregation -> Bool
Prelude.Eq, ReadPrec [FindingTypeAggregation]
ReadPrec FindingTypeAggregation
Int -> ReadS FindingTypeAggregation
ReadS [FindingTypeAggregation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FindingTypeAggregation]
$creadListPrec :: ReadPrec [FindingTypeAggregation]
readPrec :: ReadPrec FindingTypeAggregation
$creadPrec :: ReadPrec FindingTypeAggregation
readList :: ReadS [FindingTypeAggregation]
$creadList :: ReadS [FindingTypeAggregation]
readsPrec :: Int -> ReadS FindingTypeAggregation
$creadsPrec :: Int -> ReadS FindingTypeAggregation
Prelude.Read, Int -> FindingTypeAggregation -> ShowS
[FindingTypeAggregation] -> ShowS
FindingTypeAggregation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FindingTypeAggregation] -> ShowS
$cshowList :: [FindingTypeAggregation] -> ShowS
show :: FindingTypeAggregation -> String
$cshow :: FindingTypeAggregation -> String
showsPrec :: Int -> FindingTypeAggregation -> ShowS
$cshowsPrec :: Int -> FindingTypeAggregation -> ShowS
Prelude.Show, forall x. Rep FindingTypeAggregation x -> FindingTypeAggregation
forall x. FindingTypeAggregation -> Rep FindingTypeAggregation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FindingTypeAggregation x -> FindingTypeAggregation
$cfrom :: forall x. FindingTypeAggregation -> Rep FindingTypeAggregation x
Prelude.Generic)

-- |
-- Create a value of 'FindingTypeAggregation' 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:
--
-- 'findingType', 'findingTypeAggregation_findingType' - The finding type to aggregate.
--
-- 'resourceType', 'findingTypeAggregation_resourceType' - The resource type to aggregate.
--
-- 'sortBy', 'findingTypeAggregation_sortBy' - The value to sort results by.
--
-- 'sortOrder', 'findingTypeAggregation_sortOrder' - The order to sort results by.
newFindingTypeAggregation ::
  FindingTypeAggregation
newFindingTypeAggregation :: FindingTypeAggregation
newFindingTypeAggregation =
  FindingTypeAggregation'
    { $sel:findingType:FindingTypeAggregation' :: Maybe AggregationFindingType
findingType =
        forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:FindingTypeAggregation' :: Maybe AggregationResourceType
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:FindingTypeAggregation' :: Maybe FindingTypeSortBy
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:sortOrder:FindingTypeAggregation' :: Maybe SortOrder
sortOrder = forall a. Maybe a
Prelude.Nothing
    }

-- | The finding type to aggregate.
findingTypeAggregation_findingType :: Lens.Lens' FindingTypeAggregation (Prelude.Maybe AggregationFindingType)
findingTypeAggregation_findingType :: Lens' FindingTypeAggregation (Maybe AggregationFindingType)
findingTypeAggregation_findingType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FindingTypeAggregation' {Maybe AggregationFindingType
findingType :: Maybe AggregationFindingType
$sel:findingType:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe AggregationFindingType
findingType} -> Maybe AggregationFindingType
findingType) (\s :: FindingTypeAggregation
s@FindingTypeAggregation' {} Maybe AggregationFindingType
a -> FindingTypeAggregation
s {$sel:findingType:FindingTypeAggregation' :: Maybe AggregationFindingType
findingType = Maybe AggregationFindingType
a} :: FindingTypeAggregation)

-- | The resource type to aggregate.
findingTypeAggregation_resourceType :: Lens.Lens' FindingTypeAggregation (Prelude.Maybe AggregationResourceType)
findingTypeAggregation_resourceType :: Lens' FindingTypeAggregation (Maybe AggregationResourceType)
findingTypeAggregation_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FindingTypeAggregation' {Maybe AggregationResourceType
resourceType :: Maybe AggregationResourceType
$sel:resourceType:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe AggregationResourceType
resourceType} -> Maybe AggregationResourceType
resourceType) (\s :: FindingTypeAggregation
s@FindingTypeAggregation' {} Maybe AggregationResourceType
a -> FindingTypeAggregation
s {$sel:resourceType:FindingTypeAggregation' :: Maybe AggregationResourceType
resourceType = Maybe AggregationResourceType
a} :: FindingTypeAggregation)

-- | The value to sort results by.
findingTypeAggregation_sortBy :: Lens.Lens' FindingTypeAggregation (Prelude.Maybe FindingTypeSortBy)
findingTypeAggregation_sortBy :: Lens' FindingTypeAggregation (Maybe FindingTypeSortBy)
findingTypeAggregation_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FindingTypeAggregation' {Maybe FindingTypeSortBy
sortBy :: Maybe FindingTypeSortBy
$sel:sortBy:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe FindingTypeSortBy
sortBy} -> Maybe FindingTypeSortBy
sortBy) (\s :: FindingTypeAggregation
s@FindingTypeAggregation' {} Maybe FindingTypeSortBy
a -> FindingTypeAggregation
s {$sel:sortBy:FindingTypeAggregation' :: Maybe FindingTypeSortBy
sortBy = Maybe FindingTypeSortBy
a} :: FindingTypeAggregation)

-- | The order to sort results by.
findingTypeAggregation_sortOrder :: Lens.Lens' FindingTypeAggregation (Prelude.Maybe SortOrder)
findingTypeAggregation_sortOrder :: Lens' FindingTypeAggregation (Maybe SortOrder)
findingTypeAggregation_sortOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FindingTypeAggregation' {Maybe SortOrder
sortOrder :: Maybe SortOrder
$sel:sortOrder:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe SortOrder
sortOrder} -> Maybe SortOrder
sortOrder) (\s :: FindingTypeAggregation
s@FindingTypeAggregation' {} Maybe SortOrder
a -> FindingTypeAggregation
s {$sel:sortOrder:FindingTypeAggregation' :: Maybe SortOrder
sortOrder = Maybe SortOrder
a} :: FindingTypeAggregation)

instance Prelude.Hashable FindingTypeAggregation where
  hashWithSalt :: Int -> FindingTypeAggregation -> Int
hashWithSalt Int
_salt FindingTypeAggregation' {Maybe AggregationFindingType
Maybe AggregationResourceType
Maybe FindingTypeSortBy
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe FindingTypeSortBy
resourceType :: Maybe AggregationResourceType
findingType :: Maybe AggregationFindingType
$sel:sortOrder:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe SortOrder
$sel:sortBy:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe FindingTypeSortBy
$sel:resourceType:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe AggregationResourceType
$sel:findingType:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe AggregationFindingType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AggregationFindingType
findingType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AggregationResourceType
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FindingTypeSortBy
sortBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SortOrder
sortOrder

instance Prelude.NFData FindingTypeAggregation where
  rnf :: FindingTypeAggregation -> ()
rnf FindingTypeAggregation' {Maybe AggregationFindingType
Maybe AggregationResourceType
Maybe FindingTypeSortBy
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe FindingTypeSortBy
resourceType :: Maybe AggregationResourceType
findingType :: Maybe AggregationFindingType
$sel:sortOrder:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe SortOrder
$sel:sortBy:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe FindingTypeSortBy
$sel:resourceType:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe AggregationResourceType
$sel:findingType:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe AggregationFindingType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AggregationFindingType
findingType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AggregationResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FindingTypeSortBy
sortBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SortOrder
sortOrder

instance Data.ToJSON FindingTypeAggregation where
  toJSON :: FindingTypeAggregation -> Value
toJSON FindingTypeAggregation' {Maybe AggregationFindingType
Maybe AggregationResourceType
Maybe FindingTypeSortBy
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe FindingTypeSortBy
resourceType :: Maybe AggregationResourceType
findingType :: Maybe AggregationFindingType
$sel:sortOrder:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe SortOrder
$sel:sortBy:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe FindingTypeSortBy
$sel:resourceType:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe AggregationResourceType
$sel:findingType:FindingTypeAggregation' :: FindingTypeAggregation -> Maybe AggregationFindingType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"findingType" 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 AggregationFindingType
findingType,
            (Key
"resourceType" 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 AggregationResourceType
resourceType,
            (Key
"sortBy" 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 FindingTypeSortBy
sortBy,
            (Key
"sortOrder" 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 SortOrder
sortOrder
          ]
      )