{-# 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.S3.Types.InventoryConfiguration
-- 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.S3.Types.InventoryConfiguration where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.S3.Internal
import Amazonka.S3.Types.InventoryDestination
import Amazonka.S3.Types.InventoryFilter
import Amazonka.S3.Types.InventoryIncludedObjectVersions
import Amazonka.S3.Types.InventoryOptionalField
import Amazonka.S3.Types.InventorySchedule

-- | Specifies the inventory configuration for an Amazon S3 bucket. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketGETInventoryConfig.html GET Bucket inventory>
-- in the /Amazon S3 API Reference/.
--
-- /See:/ 'newInventoryConfiguration' smart constructor.
data InventoryConfiguration = InventoryConfiguration'
  { -- | Specifies an inventory filter. The inventory only includes objects that
    -- meet the filter\'s criteria.
    InventoryConfiguration -> Maybe InventoryFilter
filter' :: Prelude.Maybe InventoryFilter,
    -- | Contains the optional fields that are included in the inventory results.
    InventoryConfiguration -> Maybe [InventoryOptionalField]
optionalFields :: Prelude.Maybe [InventoryOptionalField],
    -- | Contains information about where to publish the inventory results.
    InventoryConfiguration -> InventoryDestination
destination :: InventoryDestination,
    -- | Specifies whether the inventory is enabled or disabled. If set to
    -- @True@, an inventory list is generated. If set to @False@, no inventory
    -- list is generated.
    InventoryConfiguration -> Bool
isEnabled :: Prelude.Bool,
    -- | The ID used to identify the inventory configuration.
    InventoryConfiguration -> Text
id :: Prelude.Text,
    -- | Object versions to include in the inventory list. If set to @All@, the
    -- list includes all the object versions, which adds the version-related
    -- fields @VersionId@, @IsLatest@, and @DeleteMarker@ to the list. If set
    -- to @Current@, the list does not contain these version-related fields.
    InventoryConfiguration -> InventoryIncludedObjectVersions
includedObjectVersions :: InventoryIncludedObjectVersions,
    -- | Specifies the schedule for generating inventory results.
    InventoryConfiguration -> InventorySchedule
schedule :: InventorySchedule
  }
  deriving (InventoryConfiguration -> InventoryConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InventoryConfiguration -> InventoryConfiguration -> Bool
$c/= :: InventoryConfiguration -> InventoryConfiguration -> Bool
== :: InventoryConfiguration -> InventoryConfiguration -> Bool
$c== :: InventoryConfiguration -> InventoryConfiguration -> Bool
Prelude.Eq, Int -> InventoryConfiguration -> ShowS
[InventoryConfiguration] -> ShowS
InventoryConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InventoryConfiguration] -> ShowS
$cshowList :: [InventoryConfiguration] -> ShowS
show :: InventoryConfiguration -> String
$cshow :: InventoryConfiguration -> String
showsPrec :: Int -> InventoryConfiguration -> ShowS
$cshowsPrec :: Int -> InventoryConfiguration -> ShowS
Prelude.Show, forall x. Rep InventoryConfiguration x -> InventoryConfiguration
forall x. InventoryConfiguration -> Rep InventoryConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InventoryConfiguration x -> InventoryConfiguration
$cfrom :: forall x. InventoryConfiguration -> Rep InventoryConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'InventoryConfiguration' 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:
--
-- 'filter'', 'inventoryConfiguration_filter' - Specifies an inventory filter. The inventory only includes objects that
-- meet the filter\'s criteria.
--
-- 'optionalFields', 'inventoryConfiguration_optionalFields' - Contains the optional fields that are included in the inventory results.
--
-- 'destination', 'inventoryConfiguration_destination' - Contains information about where to publish the inventory results.
--
-- 'isEnabled', 'inventoryConfiguration_isEnabled' - Specifies whether the inventory is enabled or disabled. If set to
-- @True@, an inventory list is generated. If set to @False@, no inventory
-- list is generated.
--
-- 'id', 'inventoryConfiguration_id' - The ID used to identify the inventory configuration.
--
-- 'includedObjectVersions', 'inventoryConfiguration_includedObjectVersions' - Object versions to include in the inventory list. If set to @All@, the
-- list includes all the object versions, which adds the version-related
-- fields @VersionId@, @IsLatest@, and @DeleteMarker@ to the list. If set
-- to @Current@, the list does not contain these version-related fields.
--
-- 'schedule', 'inventoryConfiguration_schedule' - Specifies the schedule for generating inventory results.
newInventoryConfiguration ::
  -- | 'destination'
  InventoryDestination ->
  -- | 'isEnabled'
  Prelude.Bool ->
  -- | 'id'
  Prelude.Text ->
  -- | 'includedObjectVersions'
  InventoryIncludedObjectVersions ->
  -- | 'schedule'
  InventorySchedule ->
  InventoryConfiguration
newInventoryConfiguration :: InventoryDestination
-> Bool
-> Text
-> InventoryIncludedObjectVersions
-> InventorySchedule
-> InventoryConfiguration
newInventoryConfiguration
  InventoryDestination
pDestination_
  Bool
pIsEnabled_
  Text
pId_
  InventoryIncludedObjectVersions
pIncludedObjectVersions_
  InventorySchedule
pSchedule_ =
    InventoryConfiguration'
      { $sel:filter':InventoryConfiguration' :: Maybe InventoryFilter
filter' = forall a. Maybe a
Prelude.Nothing,
        $sel:optionalFields:InventoryConfiguration' :: Maybe [InventoryOptionalField]
optionalFields = forall a. Maybe a
Prelude.Nothing,
        $sel:destination:InventoryConfiguration' :: InventoryDestination
destination = InventoryDestination
pDestination_,
        $sel:isEnabled:InventoryConfiguration' :: Bool
isEnabled = Bool
pIsEnabled_,
        $sel:id:InventoryConfiguration' :: Text
id = Text
pId_,
        $sel:includedObjectVersions:InventoryConfiguration' :: InventoryIncludedObjectVersions
includedObjectVersions = InventoryIncludedObjectVersions
pIncludedObjectVersions_,
        $sel:schedule:InventoryConfiguration' :: InventorySchedule
schedule = InventorySchedule
pSchedule_
      }

-- | Specifies an inventory filter. The inventory only includes objects that
-- meet the filter\'s criteria.
inventoryConfiguration_filter :: Lens.Lens' InventoryConfiguration (Prelude.Maybe InventoryFilter)
inventoryConfiguration_filter :: Lens' InventoryConfiguration (Maybe InventoryFilter)
inventoryConfiguration_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InventoryConfiguration' {Maybe InventoryFilter
filter' :: Maybe InventoryFilter
$sel:filter':InventoryConfiguration' :: InventoryConfiguration -> Maybe InventoryFilter
filter'} -> Maybe InventoryFilter
filter') (\s :: InventoryConfiguration
s@InventoryConfiguration' {} Maybe InventoryFilter
a -> InventoryConfiguration
s {$sel:filter':InventoryConfiguration' :: Maybe InventoryFilter
filter' = Maybe InventoryFilter
a} :: InventoryConfiguration)

-- | Contains the optional fields that are included in the inventory results.
inventoryConfiguration_optionalFields :: Lens.Lens' InventoryConfiguration (Prelude.Maybe [InventoryOptionalField])
inventoryConfiguration_optionalFields :: Lens' InventoryConfiguration (Maybe [InventoryOptionalField])
inventoryConfiguration_optionalFields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InventoryConfiguration' {Maybe [InventoryOptionalField]
optionalFields :: Maybe [InventoryOptionalField]
$sel:optionalFields:InventoryConfiguration' :: InventoryConfiguration -> Maybe [InventoryOptionalField]
optionalFields} -> Maybe [InventoryOptionalField]
optionalFields) (\s :: InventoryConfiguration
s@InventoryConfiguration' {} Maybe [InventoryOptionalField]
a -> InventoryConfiguration
s {$sel:optionalFields:InventoryConfiguration' :: Maybe [InventoryOptionalField]
optionalFields = Maybe [InventoryOptionalField]
a} :: InventoryConfiguration) 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

-- | Contains information about where to publish the inventory results.
inventoryConfiguration_destination :: Lens.Lens' InventoryConfiguration InventoryDestination
inventoryConfiguration_destination :: Lens' InventoryConfiguration InventoryDestination
inventoryConfiguration_destination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InventoryConfiguration' {InventoryDestination
destination :: InventoryDestination
$sel:destination:InventoryConfiguration' :: InventoryConfiguration -> InventoryDestination
destination} -> InventoryDestination
destination) (\s :: InventoryConfiguration
s@InventoryConfiguration' {} InventoryDestination
a -> InventoryConfiguration
s {$sel:destination:InventoryConfiguration' :: InventoryDestination
destination = InventoryDestination
a} :: InventoryConfiguration)

-- | Specifies whether the inventory is enabled or disabled. If set to
-- @True@, an inventory list is generated. If set to @False@, no inventory
-- list is generated.
inventoryConfiguration_isEnabled :: Lens.Lens' InventoryConfiguration Prelude.Bool
inventoryConfiguration_isEnabled :: Lens' InventoryConfiguration Bool
inventoryConfiguration_isEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InventoryConfiguration' {Bool
isEnabled :: Bool
$sel:isEnabled:InventoryConfiguration' :: InventoryConfiguration -> Bool
isEnabled} -> Bool
isEnabled) (\s :: InventoryConfiguration
s@InventoryConfiguration' {} Bool
a -> InventoryConfiguration
s {$sel:isEnabled:InventoryConfiguration' :: Bool
isEnabled = Bool
a} :: InventoryConfiguration)

-- | The ID used to identify the inventory configuration.
inventoryConfiguration_id :: Lens.Lens' InventoryConfiguration Prelude.Text
inventoryConfiguration_id :: Lens' InventoryConfiguration Text
inventoryConfiguration_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InventoryConfiguration' {Text
id :: Text
$sel:id:InventoryConfiguration' :: InventoryConfiguration -> Text
id} -> Text
id) (\s :: InventoryConfiguration
s@InventoryConfiguration' {} Text
a -> InventoryConfiguration
s {$sel:id:InventoryConfiguration' :: Text
id = Text
a} :: InventoryConfiguration)

-- | Object versions to include in the inventory list. If set to @All@, the
-- list includes all the object versions, which adds the version-related
-- fields @VersionId@, @IsLatest@, and @DeleteMarker@ to the list. If set
-- to @Current@, the list does not contain these version-related fields.
inventoryConfiguration_includedObjectVersions :: Lens.Lens' InventoryConfiguration InventoryIncludedObjectVersions
inventoryConfiguration_includedObjectVersions :: Lens' InventoryConfiguration InventoryIncludedObjectVersions
inventoryConfiguration_includedObjectVersions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InventoryConfiguration' {InventoryIncludedObjectVersions
includedObjectVersions :: InventoryIncludedObjectVersions
$sel:includedObjectVersions:InventoryConfiguration' :: InventoryConfiguration -> InventoryIncludedObjectVersions
includedObjectVersions} -> InventoryIncludedObjectVersions
includedObjectVersions) (\s :: InventoryConfiguration
s@InventoryConfiguration' {} InventoryIncludedObjectVersions
a -> InventoryConfiguration
s {$sel:includedObjectVersions:InventoryConfiguration' :: InventoryIncludedObjectVersions
includedObjectVersions = InventoryIncludedObjectVersions
a} :: InventoryConfiguration)

-- | Specifies the schedule for generating inventory results.
inventoryConfiguration_schedule :: Lens.Lens' InventoryConfiguration InventorySchedule
inventoryConfiguration_schedule :: Lens' InventoryConfiguration InventorySchedule
inventoryConfiguration_schedule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InventoryConfiguration' {InventorySchedule
schedule :: InventorySchedule
$sel:schedule:InventoryConfiguration' :: InventoryConfiguration -> InventorySchedule
schedule} -> InventorySchedule
schedule) (\s :: InventoryConfiguration
s@InventoryConfiguration' {} InventorySchedule
a -> InventoryConfiguration
s {$sel:schedule:InventoryConfiguration' :: InventorySchedule
schedule = InventorySchedule
a} :: InventoryConfiguration)

instance Data.FromXML InventoryConfiguration where
  parseXML :: [Node] -> Either String InventoryConfiguration
parseXML [Node]
x =
    Maybe InventoryFilter
-> Maybe [InventoryOptionalField]
-> InventoryDestination
-> Bool
-> Text
-> InventoryIncludedObjectVersions
-> InventorySchedule
-> InventoryConfiguration
InventoryConfiguration'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Filter")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"OptionalFields"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"Field")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Destination")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"IsEnabled")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Id")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"IncludedObjectVersions")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Schedule")

instance Prelude.Hashable InventoryConfiguration where
  hashWithSalt :: Int -> InventoryConfiguration -> Int
hashWithSalt Int
_salt InventoryConfiguration' {Bool
Maybe [InventoryOptionalField]
Maybe InventoryFilter
Text
InventoryIncludedObjectVersions
InventorySchedule
InventoryDestination
schedule :: InventorySchedule
includedObjectVersions :: InventoryIncludedObjectVersions
id :: Text
isEnabled :: Bool
destination :: InventoryDestination
optionalFields :: Maybe [InventoryOptionalField]
filter' :: Maybe InventoryFilter
$sel:schedule:InventoryConfiguration' :: InventoryConfiguration -> InventorySchedule
$sel:includedObjectVersions:InventoryConfiguration' :: InventoryConfiguration -> InventoryIncludedObjectVersions
$sel:id:InventoryConfiguration' :: InventoryConfiguration -> Text
$sel:isEnabled:InventoryConfiguration' :: InventoryConfiguration -> Bool
$sel:destination:InventoryConfiguration' :: InventoryConfiguration -> InventoryDestination
$sel:optionalFields:InventoryConfiguration' :: InventoryConfiguration -> Maybe [InventoryOptionalField]
$sel:filter':InventoryConfiguration' :: InventoryConfiguration -> Maybe InventoryFilter
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InventoryFilter
filter'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InventoryOptionalField]
optionalFields
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` InventoryDestination
destination
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
isEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` InventoryIncludedObjectVersions
includedObjectVersions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` InventorySchedule
schedule

instance Prelude.NFData InventoryConfiguration where
  rnf :: InventoryConfiguration -> ()
rnf InventoryConfiguration' {Bool
Maybe [InventoryOptionalField]
Maybe InventoryFilter
Text
InventoryIncludedObjectVersions
InventorySchedule
InventoryDestination
schedule :: InventorySchedule
includedObjectVersions :: InventoryIncludedObjectVersions
id :: Text
isEnabled :: Bool
destination :: InventoryDestination
optionalFields :: Maybe [InventoryOptionalField]
filter' :: Maybe InventoryFilter
$sel:schedule:InventoryConfiguration' :: InventoryConfiguration -> InventorySchedule
$sel:includedObjectVersions:InventoryConfiguration' :: InventoryConfiguration -> InventoryIncludedObjectVersions
$sel:id:InventoryConfiguration' :: InventoryConfiguration -> Text
$sel:isEnabled:InventoryConfiguration' :: InventoryConfiguration -> Bool
$sel:destination:InventoryConfiguration' :: InventoryConfiguration -> InventoryDestination
$sel:optionalFields:InventoryConfiguration' :: InventoryConfiguration -> Maybe [InventoryOptionalField]
$sel:filter':InventoryConfiguration' :: InventoryConfiguration -> Maybe InventoryFilter
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe InventoryFilter
filter'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InventoryOptionalField]
optionalFields
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf InventoryDestination
destination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
isEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf InventoryIncludedObjectVersions
includedObjectVersions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf InventorySchedule
schedule

instance Data.ToXML InventoryConfiguration where
  toXML :: InventoryConfiguration -> XML
toXML InventoryConfiguration' {Bool
Maybe [InventoryOptionalField]
Maybe InventoryFilter
Text
InventoryIncludedObjectVersions
InventorySchedule
InventoryDestination
schedule :: InventorySchedule
includedObjectVersions :: InventoryIncludedObjectVersions
id :: Text
isEnabled :: Bool
destination :: InventoryDestination
optionalFields :: Maybe [InventoryOptionalField]
filter' :: Maybe InventoryFilter
$sel:schedule:InventoryConfiguration' :: InventoryConfiguration -> InventorySchedule
$sel:includedObjectVersions:InventoryConfiguration' :: InventoryConfiguration -> InventoryIncludedObjectVersions
$sel:id:InventoryConfiguration' :: InventoryConfiguration -> Text
$sel:isEnabled:InventoryConfiguration' :: InventoryConfiguration -> Bool
$sel:destination:InventoryConfiguration' :: InventoryConfiguration -> InventoryDestination
$sel:optionalFields:InventoryConfiguration' :: InventoryConfiguration -> Maybe [InventoryOptionalField]
$sel:filter':InventoryConfiguration' :: InventoryConfiguration -> Maybe InventoryFilter
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"Filter" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe InventoryFilter
filter',
        Name
"OptionalFields"
          forall a. ToXML a => Name -> a -> XML
Data.@= forall a. ToXML a => a -> XML
Data.toXML
            (forall a. (IsList a, ToXML (Item a)) => Name -> a -> XML
Data.toXMLList Name
"Field" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [InventoryOptionalField]
optionalFields),
        Name
"Destination" forall a. ToXML a => Name -> a -> XML
Data.@= InventoryDestination
destination,
        Name
"IsEnabled" forall a. ToXML a => Name -> a -> XML
Data.@= Bool
isEnabled,
        Name
"Id" forall a. ToXML a => Name -> a -> XML
Data.@= Text
id,
        Name
"IncludedObjectVersions"
          forall a. ToXML a => Name -> a -> XML
Data.@= InventoryIncludedObjectVersions
includedObjectVersions,
        Name
"Schedule" forall a. ToXML a => Name -> a -> XML
Data.@= InventorySchedule
schedule
      ]