{-# 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.AmiAggregation
-- 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.AmiAggregation 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.AmiSortBy
import Amazonka.Inspector2.Types.SortOrder
import Amazonka.Inspector2.Types.StringFilter
import qualified Amazonka.Prelude as Prelude

-- | The details that define an aggregation based on Amazon machine images
-- (AMIs).
--
-- /See:/ 'newAmiAggregation' smart constructor.
data AmiAggregation = AmiAggregation'
  { -- | The IDs of AMIs to aggregate findings for.
    AmiAggregation -> Maybe (NonEmpty StringFilter)
amis :: Prelude.Maybe (Prelude.NonEmpty StringFilter),
    -- | The value to sort results by.
    AmiAggregation -> Maybe AmiSortBy
sortBy :: Prelude.Maybe AmiSortBy,
    -- | The order to sort results by.
    AmiAggregation -> Maybe SortOrder
sortOrder :: Prelude.Maybe SortOrder
  }
  deriving (AmiAggregation -> AmiAggregation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AmiAggregation -> AmiAggregation -> Bool
$c/= :: AmiAggregation -> AmiAggregation -> Bool
== :: AmiAggregation -> AmiAggregation -> Bool
$c== :: AmiAggregation -> AmiAggregation -> Bool
Prelude.Eq, ReadPrec [AmiAggregation]
ReadPrec AmiAggregation
Int -> ReadS AmiAggregation
ReadS [AmiAggregation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AmiAggregation]
$creadListPrec :: ReadPrec [AmiAggregation]
readPrec :: ReadPrec AmiAggregation
$creadPrec :: ReadPrec AmiAggregation
readList :: ReadS [AmiAggregation]
$creadList :: ReadS [AmiAggregation]
readsPrec :: Int -> ReadS AmiAggregation
$creadsPrec :: Int -> ReadS AmiAggregation
Prelude.Read, Int -> AmiAggregation -> ShowS
[AmiAggregation] -> ShowS
AmiAggregation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AmiAggregation] -> ShowS
$cshowList :: [AmiAggregation] -> ShowS
show :: AmiAggregation -> String
$cshow :: AmiAggregation -> String
showsPrec :: Int -> AmiAggregation -> ShowS
$cshowsPrec :: Int -> AmiAggregation -> ShowS
Prelude.Show, forall x. Rep AmiAggregation x -> AmiAggregation
forall x. AmiAggregation -> Rep AmiAggregation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AmiAggregation x -> AmiAggregation
$cfrom :: forall x. AmiAggregation -> Rep AmiAggregation x
Prelude.Generic)

-- |
-- Create a value of 'AmiAggregation' 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:
--
-- 'amis', 'amiAggregation_amis' - The IDs of AMIs to aggregate findings for.
--
-- 'sortBy', 'amiAggregation_sortBy' - The value to sort results by.
--
-- 'sortOrder', 'amiAggregation_sortOrder' - The order to sort results by.
newAmiAggregation ::
  AmiAggregation
newAmiAggregation :: AmiAggregation
newAmiAggregation =
  AmiAggregation'
    { $sel:amis:AmiAggregation' :: Maybe (NonEmpty StringFilter)
amis = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:AmiAggregation' :: Maybe AmiSortBy
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:sortOrder:AmiAggregation' :: Maybe SortOrder
sortOrder = forall a. Maybe a
Prelude.Nothing
    }

-- | The IDs of AMIs to aggregate findings for.
amiAggregation_amis :: Lens.Lens' AmiAggregation (Prelude.Maybe (Prelude.NonEmpty StringFilter))
amiAggregation_amis :: Lens' AmiAggregation (Maybe (NonEmpty StringFilter))
amiAggregation_amis = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AmiAggregation' {Maybe (NonEmpty StringFilter)
amis :: Maybe (NonEmpty StringFilter)
$sel:amis:AmiAggregation' :: AmiAggregation -> Maybe (NonEmpty StringFilter)
amis} -> Maybe (NonEmpty StringFilter)
amis) (\s :: AmiAggregation
s@AmiAggregation' {} Maybe (NonEmpty StringFilter)
a -> AmiAggregation
s {$sel:amis:AmiAggregation' :: Maybe (NonEmpty StringFilter)
amis = Maybe (NonEmpty StringFilter)
a} :: AmiAggregation) 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 value to sort results by.
amiAggregation_sortBy :: Lens.Lens' AmiAggregation (Prelude.Maybe AmiSortBy)
amiAggregation_sortBy :: Lens' AmiAggregation (Maybe AmiSortBy)
amiAggregation_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AmiAggregation' {Maybe AmiSortBy
sortBy :: Maybe AmiSortBy
$sel:sortBy:AmiAggregation' :: AmiAggregation -> Maybe AmiSortBy
sortBy} -> Maybe AmiSortBy
sortBy) (\s :: AmiAggregation
s@AmiAggregation' {} Maybe AmiSortBy
a -> AmiAggregation
s {$sel:sortBy:AmiAggregation' :: Maybe AmiSortBy
sortBy = Maybe AmiSortBy
a} :: AmiAggregation)

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

instance Prelude.Hashable AmiAggregation where
  hashWithSalt :: Int -> AmiAggregation -> Int
hashWithSalt Int
_salt AmiAggregation' {Maybe (NonEmpty StringFilter)
Maybe AmiSortBy
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe AmiSortBy
amis :: Maybe (NonEmpty StringFilter)
$sel:sortOrder:AmiAggregation' :: AmiAggregation -> Maybe SortOrder
$sel:sortBy:AmiAggregation' :: AmiAggregation -> Maybe AmiSortBy
$sel:amis:AmiAggregation' :: AmiAggregation -> Maybe (NonEmpty StringFilter)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty StringFilter)
amis
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AmiSortBy
sortBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SortOrder
sortOrder

instance Prelude.NFData AmiAggregation where
  rnf :: AmiAggregation -> ()
rnf AmiAggregation' {Maybe (NonEmpty StringFilter)
Maybe AmiSortBy
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe AmiSortBy
amis :: Maybe (NonEmpty StringFilter)
$sel:sortOrder:AmiAggregation' :: AmiAggregation -> Maybe SortOrder
$sel:sortBy:AmiAggregation' :: AmiAggregation -> Maybe AmiSortBy
$sel:amis:AmiAggregation' :: AmiAggregation -> Maybe (NonEmpty StringFilter)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty StringFilter)
amis
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AmiSortBy
sortBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SortOrder
sortOrder

instance Data.ToJSON AmiAggregation where
  toJSON :: AmiAggregation -> Value
toJSON AmiAggregation' {Maybe (NonEmpty StringFilter)
Maybe AmiSortBy
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe AmiSortBy
amis :: Maybe (NonEmpty StringFilter)
$sel:sortOrder:AmiAggregation' :: AmiAggregation -> Maybe SortOrder
$sel:sortBy:AmiAggregation' :: AmiAggregation -> Maybe AmiSortBy
$sel:amis:AmiAggregation' :: AmiAggregation -> Maybe (NonEmpty StringFilter)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"amis" 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 (NonEmpty StringFilter)
amis,
            (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 AmiSortBy
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
          ]
      )