{-# 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.AccountAggregation
-- 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.AccountAggregation 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.AccountSortBy
import Amazonka.Inspector2.Types.AggregationFindingType
import Amazonka.Inspector2.Types.AggregationResourceType
import Amazonka.Inspector2.Types.SortOrder
import qualified Amazonka.Prelude as Prelude

-- | An object that contains details about an aggregation response based on
-- Amazon Web Services accounts.
--
-- /See:/ 'newAccountAggregation' smart constructor.
data AccountAggregation = AccountAggregation'
  { -- | The type of finding.
    AccountAggregation -> Maybe AggregationFindingType
findingType :: Prelude.Maybe AggregationFindingType,
    -- | The type of resource.
    AccountAggregation -> Maybe AggregationResourceType
resourceType :: Prelude.Maybe AggregationResourceType,
    -- | The value to sort by.
    AccountAggregation -> Maybe AccountSortBy
sortBy :: Prelude.Maybe AccountSortBy,
    -- | The sort order (ascending or descending).
    AccountAggregation -> Maybe SortOrder
sortOrder :: Prelude.Maybe SortOrder
  }
  deriving (AccountAggregation -> AccountAggregation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountAggregation -> AccountAggregation -> Bool
$c/= :: AccountAggregation -> AccountAggregation -> Bool
== :: AccountAggregation -> AccountAggregation -> Bool
$c== :: AccountAggregation -> AccountAggregation -> Bool
Prelude.Eq, ReadPrec [AccountAggregation]
ReadPrec AccountAggregation
Int -> ReadS AccountAggregation
ReadS [AccountAggregation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AccountAggregation]
$creadListPrec :: ReadPrec [AccountAggregation]
readPrec :: ReadPrec AccountAggregation
$creadPrec :: ReadPrec AccountAggregation
readList :: ReadS [AccountAggregation]
$creadList :: ReadS [AccountAggregation]
readsPrec :: Int -> ReadS AccountAggregation
$creadsPrec :: Int -> ReadS AccountAggregation
Prelude.Read, Int -> AccountAggregation -> ShowS
[AccountAggregation] -> ShowS
AccountAggregation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountAggregation] -> ShowS
$cshowList :: [AccountAggregation] -> ShowS
show :: AccountAggregation -> String
$cshow :: AccountAggregation -> String
showsPrec :: Int -> AccountAggregation -> ShowS
$cshowsPrec :: Int -> AccountAggregation -> ShowS
Prelude.Show, forall x. Rep AccountAggregation x -> AccountAggregation
forall x. AccountAggregation -> Rep AccountAggregation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccountAggregation x -> AccountAggregation
$cfrom :: forall x. AccountAggregation -> Rep AccountAggregation x
Prelude.Generic)

-- |
-- Create a value of 'AccountAggregation' 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', 'accountAggregation_findingType' - The type of finding.
--
-- 'resourceType', 'accountAggregation_resourceType' - The type of resource.
--
-- 'sortBy', 'accountAggregation_sortBy' - The value to sort by.
--
-- 'sortOrder', 'accountAggregation_sortOrder' - The sort order (ascending or descending).
newAccountAggregation ::
  AccountAggregation
newAccountAggregation :: AccountAggregation
newAccountAggregation =
  AccountAggregation'
    { $sel:findingType:AccountAggregation' :: Maybe AggregationFindingType
findingType = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:AccountAggregation' :: Maybe AggregationResourceType
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:AccountAggregation' :: Maybe AccountSortBy
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:sortOrder:AccountAggregation' :: Maybe SortOrder
sortOrder = forall a. Maybe a
Prelude.Nothing
    }

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

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

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

-- | The sort order (ascending or descending).
accountAggregation_sortOrder :: Lens.Lens' AccountAggregation (Prelude.Maybe SortOrder)
accountAggregation_sortOrder :: Lens' AccountAggregation (Maybe SortOrder)
accountAggregation_sortOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccountAggregation' {Maybe SortOrder
sortOrder :: Maybe SortOrder
$sel:sortOrder:AccountAggregation' :: AccountAggregation -> Maybe SortOrder
sortOrder} -> Maybe SortOrder
sortOrder) (\s :: AccountAggregation
s@AccountAggregation' {} Maybe SortOrder
a -> AccountAggregation
s {$sel:sortOrder:AccountAggregation' :: Maybe SortOrder
sortOrder = Maybe SortOrder
a} :: AccountAggregation)

instance Prelude.Hashable AccountAggregation where
  hashWithSalt :: Int -> AccountAggregation -> Int
hashWithSalt Int
_salt AccountAggregation' {Maybe AccountSortBy
Maybe AggregationFindingType
Maybe AggregationResourceType
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe AccountSortBy
resourceType :: Maybe AggregationResourceType
findingType :: Maybe AggregationFindingType
$sel:sortOrder:AccountAggregation' :: AccountAggregation -> Maybe SortOrder
$sel:sortBy:AccountAggregation' :: AccountAggregation -> Maybe AccountSortBy
$sel:resourceType:AccountAggregation' :: AccountAggregation -> Maybe AggregationResourceType
$sel:findingType:AccountAggregation' :: AccountAggregation -> 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 AccountSortBy
sortBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SortOrder
sortOrder

instance Prelude.NFData AccountAggregation where
  rnf :: AccountAggregation -> ()
rnf AccountAggregation' {Maybe AccountSortBy
Maybe AggregationFindingType
Maybe AggregationResourceType
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe AccountSortBy
resourceType :: Maybe AggregationResourceType
findingType :: Maybe AggregationFindingType
$sel:sortOrder:AccountAggregation' :: AccountAggregation -> Maybe SortOrder
$sel:sortBy:AccountAggregation' :: AccountAggregation -> Maybe AccountSortBy
$sel:resourceType:AccountAggregation' :: AccountAggregation -> Maybe AggregationResourceType
$sel:findingType:AccountAggregation' :: AccountAggregation -> 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 AccountSortBy
sortBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SortOrder
sortOrder

instance Data.ToJSON AccountAggregation where
  toJSON :: AccountAggregation -> Value
toJSON AccountAggregation' {Maybe AccountSortBy
Maybe AggregationFindingType
Maybe AggregationResourceType
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe AccountSortBy
resourceType :: Maybe AggregationResourceType
findingType :: Maybe AggregationFindingType
$sel:sortOrder:AccountAggregation' :: AccountAggregation -> Maybe SortOrder
$sel:sortBy:AccountAggregation' :: AccountAggregation -> Maybe AccountSortBy
$sel:resourceType:AccountAggregation' :: AccountAggregation -> Maybe AggregationResourceType
$sel:findingType:AccountAggregation' :: AccountAggregation -> 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 AccountSortBy
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
          ]
      )