{-# 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.Ec2InstanceAggregation
-- 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.Ec2InstanceAggregation 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.Ec2InstanceSortBy
import Amazonka.Inspector2.Types.MapFilter
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 EC2 instances.
--
-- /See:/ 'newEc2InstanceAggregation' smart constructor.
data Ec2InstanceAggregation = Ec2InstanceAggregation'
  { -- | The AMI IDs associated with the Amazon EC2 instances to aggregate
    -- findings for.
    Ec2InstanceAggregation -> Maybe (NonEmpty StringFilter)
amis :: Prelude.Maybe (Prelude.NonEmpty StringFilter),
    -- | The Amazon EC2 instance IDs to aggregate findings for.
    Ec2InstanceAggregation -> Maybe (NonEmpty StringFilter)
instanceIds :: Prelude.Maybe (Prelude.NonEmpty StringFilter),
    -- | The Amazon EC2 instance tags to aggregate findings for.
    Ec2InstanceAggregation -> Maybe (NonEmpty MapFilter)
instanceTags :: Prelude.Maybe (Prelude.NonEmpty MapFilter),
    -- | The operating system types to aggregate findings for. Valid values must
    -- be uppercase and underscore separated, examples are @ORACLE_LINUX_7@ and
    -- @ALPINE_LINUX_3_8@.
    Ec2InstanceAggregation -> Maybe (NonEmpty StringFilter)
operatingSystems :: Prelude.Maybe (Prelude.NonEmpty StringFilter),
    -- | The value to sort results by.
    Ec2InstanceAggregation -> Maybe Ec2InstanceSortBy
sortBy :: Prelude.Maybe Ec2InstanceSortBy,
    -- | The order to sort results by.
    Ec2InstanceAggregation -> Maybe SortOrder
sortOrder :: Prelude.Maybe SortOrder
  }
  deriving (Ec2InstanceAggregation -> Ec2InstanceAggregation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ec2InstanceAggregation -> Ec2InstanceAggregation -> Bool
$c/= :: Ec2InstanceAggregation -> Ec2InstanceAggregation -> Bool
== :: Ec2InstanceAggregation -> Ec2InstanceAggregation -> Bool
$c== :: Ec2InstanceAggregation -> Ec2InstanceAggregation -> Bool
Prelude.Eq, ReadPrec [Ec2InstanceAggregation]
ReadPrec Ec2InstanceAggregation
Int -> ReadS Ec2InstanceAggregation
ReadS [Ec2InstanceAggregation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Ec2InstanceAggregation]
$creadListPrec :: ReadPrec [Ec2InstanceAggregation]
readPrec :: ReadPrec Ec2InstanceAggregation
$creadPrec :: ReadPrec Ec2InstanceAggregation
readList :: ReadS [Ec2InstanceAggregation]
$creadList :: ReadS [Ec2InstanceAggregation]
readsPrec :: Int -> ReadS Ec2InstanceAggregation
$creadsPrec :: Int -> ReadS Ec2InstanceAggregation
Prelude.Read, Int -> Ec2InstanceAggregation -> ShowS
[Ec2InstanceAggregation] -> ShowS
Ec2InstanceAggregation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ec2InstanceAggregation] -> ShowS
$cshowList :: [Ec2InstanceAggregation] -> ShowS
show :: Ec2InstanceAggregation -> String
$cshow :: Ec2InstanceAggregation -> String
showsPrec :: Int -> Ec2InstanceAggregation -> ShowS
$cshowsPrec :: Int -> Ec2InstanceAggregation -> ShowS
Prelude.Show, forall x. Rep Ec2InstanceAggregation x -> Ec2InstanceAggregation
forall x. Ec2InstanceAggregation -> Rep Ec2InstanceAggregation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ec2InstanceAggregation x -> Ec2InstanceAggregation
$cfrom :: forall x. Ec2InstanceAggregation -> Rep Ec2InstanceAggregation x
Prelude.Generic)

-- |
-- Create a value of 'Ec2InstanceAggregation' 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', 'ec2InstanceAggregation_amis' - The AMI IDs associated with the Amazon EC2 instances to aggregate
-- findings for.
--
-- 'instanceIds', 'ec2InstanceAggregation_instanceIds' - The Amazon EC2 instance IDs to aggregate findings for.
--
-- 'instanceTags', 'ec2InstanceAggregation_instanceTags' - The Amazon EC2 instance tags to aggregate findings for.
--
-- 'operatingSystems', 'ec2InstanceAggregation_operatingSystems' - The operating system types to aggregate findings for. Valid values must
-- be uppercase and underscore separated, examples are @ORACLE_LINUX_7@ and
-- @ALPINE_LINUX_3_8@.
--
-- 'sortBy', 'ec2InstanceAggregation_sortBy' - The value to sort results by.
--
-- 'sortOrder', 'ec2InstanceAggregation_sortOrder' - The order to sort results by.
newEc2InstanceAggregation ::
  Ec2InstanceAggregation
newEc2InstanceAggregation :: Ec2InstanceAggregation
newEc2InstanceAggregation =
  Ec2InstanceAggregation'
    { $sel:amis:Ec2InstanceAggregation' :: Maybe (NonEmpty StringFilter)
amis = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceIds:Ec2InstanceAggregation' :: Maybe (NonEmpty StringFilter)
instanceIds = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceTags:Ec2InstanceAggregation' :: Maybe (NonEmpty MapFilter)
instanceTags = forall a. Maybe a
Prelude.Nothing,
      $sel:operatingSystems:Ec2InstanceAggregation' :: Maybe (NonEmpty StringFilter)
operatingSystems = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:Ec2InstanceAggregation' :: Maybe Ec2InstanceSortBy
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:sortOrder:Ec2InstanceAggregation' :: Maybe SortOrder
sortOrder = forall a. Maybe a
Prelude.Nothing
    }

-- | The AMI IDs associated with the Amazon EC2 instances to aggregate
-- findings for.
ec2InstanceAggregation_amis :: Lens.Lens' Ec2InstanceAggregation (Prelude.Maybe (Prelude.NonEmpty StringFilter))
ec2InstanceAggregation_amis :: Lens' Ec2InstanceAggregation (Maybe (NonEmpty StringFilter))
ec2InstanceAggregation_amis = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ec2InstanceAggregation' {Maybe (NonEmpty StringFilter)
amis :: Maybe (NonEmpty StringFilter)
$sel:amis:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe (NonEmpty StringFilter)
amis} -> Maybe (NonEmpty StringFilter)
amis) (\s :: Ec2InstanceAggregation
s@Ec2InstanceAggregation' {} Maybe (NonEmpty StringFilter)
a -> Ec2InstanceAggregation
s {$sel:amis:Ec2InstanceAggregation' :: Maybe (NonEmpty StringFilter)
amis = Maybe (NonEmpty StringFilter)
a} :: Ec2InstanceAggregation) 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 Amazon EC2 instance IDs to aggregate findings for.
ec2InstanceAggregation_instanceIds :: Lens.Lens' Ec2InstanceAggregation (Prelude.Maybe (Prelude.NonEmpty StringFilter))
ec2InstanceAggregation_instanceIds :: Lens' Ec2InstanceAggregation (Maybe (NonEmpty StringFilter))
ec2InstanceAggregation_instanceIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ec2InstanceAggregation' {Maybe (NonEmpty StringFilter)
instanceIds :: Maybe (NonEmpty StringFilter)
$sel:instanceIds:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe (NonEmpty StringFilter)
instanceIds} -> Maybe (NonEmpty StringFilter)
instanceIds) (\s :: Ec2InstanceAggregation
s@Ec2InstanceAggregation' {} Maybe (NonEmpty StringFilter)
a -> Ec2InstanceAggregation
s {$sel:instanceIds:Ec2InstanceAggregation' :: Maybe (NonEmpty StringFilter)
instanceIds = Maybe (NonEmpty StringFilter)
a} :: Ec2InstanceAggregation) 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 Amazon EC2 instance tags to aggregate findings for.
ec2InstanceAggregation_instanceTags :: Lens.Lens' Ec2InstanceAggregation (Prelude.Maybe (Prelude.NonEmpty MapFilter))
ec2InstanceAggregation_instanceTags :: Lens' Ec2InstanceAggregation (Maybe (NonEmpty MapFilter))
ec2InstanceAggregation_instanceTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ec2InstanceAggregation' {Maybe (NonEmpty MapFilter)
instanceTags :: Maybe (NonEmpty MapFilter)
$sel:instanceTags:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe (NonEmpty MapFilter)
instanceTags} -> Maybe (NonEmpty MapFilter)
instanceTags) (\s :: Ec2InstanceAggregation
s@Ec2InstanceAggregation' {} Maybe (NonEmpty MapFilter)
a -> Ec2InstanceAggregation
s {$sel:instanceTags:Ec2InstanceAggregation' :: Maybe (NonEmpty MapFilter)
instanceTags = Maybe (NonEmpty MapFilter)
a} :: Ec2InstanceAggregation) 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 operating system types to aggregate findings for. Valid values must
-- be uppercase and underscore separated, examples are @ORACLE_LINUX_7@ and
-- @ALPINE_LINUX_3_8@.
ec2InstanceAggregation_operatingSystems :: Lens.Lens' Ec2InstanceAggregation (Prelude.Maybe (Prelude.NonEmpty StringFilter))
ec2InstanceAggregation_operatingSystems :: Lens' Ec2InstanceAggregation (Maybe (NonEmpty StringFilter))
ec2InstanceAggregation_operatingSystems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ec2InstanceAggregation' {Maybe (NonEmpty StringFilter)
operatingSystems :: Maybe (NonEmpty StringFilter)
$sel:operatingSystems:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe (NonEmpty StringFilter)
operatingSystems} -> Maybe (NonEmpty StringFilter)
operatingSystems) (\s :: Ec2InstanceAggregation
s@Ec2InstanceAggregation' {} Maybe (NonEmpty StringFilter)
a -> Ec2InstanceAggregation
s {$sel:operatingSystems:Ec2InstanceAggregation' :: Maybe (NonEmpty StringFilter)
operatingSystems = Maybe (NonEmpty StringFilter)
a} :: Ec2InstanceAggregation) 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.
ec2InstanceAggregation_sortBy :: Lens.Lens' Ec2InstanceAggregation (Prelude.Maybe Ec2InstanceSortBy)
ec2InstanceAggregation_sortBy :: Lens' Ec2InstanceAggregation (Maybe Ec2InstanceSortBy)
ec2InstanceAggregation_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Ec2InstanceAggregation' {Maybe Ec2InstanceSortBy
sortBy :: Maybe Ec2InstanceSortBy
$sel:sortBy:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe Ec2InstanceSortBy
sortBy} -> Maybe Ec2InstanceSortBy
sortBy) (\s :: Ec2InstanceAggregation
s@Ec2InstanceAggregation' {} Maybe Ec2InstanceSortBy
a -> Ec2InstanceAggregation
s {$sel:sortBy:Ec2InstanceAggregation' :: Maybe Ec2InstanceSortBy
sortBy = Maybe Ec2InstanceSortBy
a} :: Ec2InstanceAggregation)

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

instance Prelude.Hashable Ec2InstanceAggregation where
  hashWithSalt :: Int -> Ec2InstanceAggregation -> Int
hashWithSalt Int
_salt Ec2InstanceAggregation' {Maybe (NonEmpty MapFilter)
Maybe (NonEmpty StringFilter)
Maybe Ec2InstanceSortBy
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe Ec2InstanceSortBy
operatingSystems :: Maybe (NonEmpty StringFilter)
instanceTags :: Maybe (NonEmpty MapFilter)
instanceIds :: Maybe (NonEmpty StringFilter)
amis :: Maybe (NonEmpty StringFilter)
$sel:sortOrder:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe SortOrder
$sel:sortBy:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe Ec2InstanceSortBy
$sel:operatingSystems:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe (NonEmpty StringFilter)
$sel:instanceTags:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe (NonEmpty MapFilter)
$sel:instanceIds:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe (NonEmpty StringFilter)
$sel:amis:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> 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 (NonEmpty StringFilter)
instanceIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty MapFilter)
instanceTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty StringFilter)
operatingSystems
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Ec2InstanceSortBy
sortBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SortOrder
sortOrder

instance Prelude.NFData Ec2InstanceAggregation where
  rnf :: Ec2InstanceAggregation -> ()
rnf Ec2InstanceAggregation' {Maybe (NonEmpty MapFilter)
Maybe (NonEmpty StringFilter)
Maybe Ec2InstanceSortBy
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe Ec2InstanceSortBy
operatingSystems :: Maybe (NonEmpty StringFilter)
instanceTags :: Maybe (NonEmpty MapFilter)
instanceIds :: Maybe (NonEmpty StringFilter)
amis :: Maybe (NonEmpty StringFilter)
$sel:sortOrder:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe SortOrder
$sel:sortBy:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe Ec2InstanceSortBy
$sel:operatingSystems:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe (NonEmpty StringFilter)
$sel:instanceTags:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe (NonEmpty MapFilter)
$sel:instanceIds:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe (NonEmpty StringFilter)
$sel:amis:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> 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 (NonEmpty StringFilter)
instanceIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty MapFilter)
instanceTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty StringFilter)
operatingSystems
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Ec2InstanceSortBy
sortBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SortOrder
sortOrder

instance Data.ToJSON Ec2InstanceAggregation where
  toJSON :: Ec2InstanceAggregation -> Value
toJSON Ec2InstanceAggregation' {Maybe (NonEmpty MapFilter)
Maybe (NonEmpty StringFilter)
Maybe Ec2InstanceSortBy
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe Ec2InstanceSortBy
operatingSystems :: Maybe (NonEmpty StringFilter)
instanceTags :: Maybe (NonEmpty MapFilter)
instanceIds :: Maybe (NonEmpty StringFilter)
amis :: Maybe (NonEmpty StringFilter)
$sel:sortOrder:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe SortOrder
$sel:sortBy:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe Ec2InstanceSortBy
$sel:operatingSystems:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe (NonEmpty StringFilter)
$sel:instanceTags:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe (NonEmpty MapFilter)
$sel:instanceIds:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> Maybe (NonEmpty StringFilter)
$sel:amis:Ec2InstanceAggregation' :: Ec2InstanceAggregation -> 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
"instanceIds" 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)
instanceIds,
            (Key
"instanceTags" 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 MapFilter)
instanceTags,
            (Key
"operatingSystems" 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)
operatingSystems,
            (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 Ec2InstanceSortBy
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
          ]
      )