{-# 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.LifecycleRule
-- 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.LifecycleRule 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.AbortIncompleteMultipartUpload
import Amazonka.S3.Types.ExpirationStatus
import Amazonka.S3.Types.LifecycleExpiration
import Amazonka.S3.Types.LifecycleRuleFilter
import Amazonka.S3.Types.NoncurrentVersionExpiration
import Amazonka.S3.Types.NoncurrentVersionTransition
import Amazonka.S3.Types.Transition

-- | A lifecycle rule for individual objects in an Amazon S3 bucket.
--
-- /See:/ 'newLifecycleRule' smart constructor.
data LifecycleRule = LifecycleRule'
  { LifecycleRule -> Maybe AbortIncompleteMultipartUpload
abortIncompleteMultipartUpload :: Prelude.Maybe AbortIncompleteMultipartUpload,
    -- | Specifies the expiration for the lifecycle of the object in the form of
    -- date, days and, whether the object has a delete marker.
    LifecycleRule -> Maybe LifecycleExpiration
expiration :: Prelude.Maybe LifecycleExpiration,
    -- | The @Filter@ is used to identify objects that a Lifecycle Rule applies
    -- to. A @Filter@ must have exactly one of @Prefix@, @Tag@, or @And@
    -- specified. @Filter@ is required if the @LifecycleRule@ does not contain
    -- a @Prefix@ element.
    LifecycleRule -> Maybe LifecycleRuleFilter
filter' :: Prelude.Maybe LifecycleRuleFilter,
    -- | Unique identifier for the rule. The value cannot be longer than 255
    -- characters.
    LifecycleRule -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    LifecycleRule -> Maybe NoncurrentVersionExpiration
noncurrentVersionExpiration :: Prelude.Maybe NoncurrentVersionExpiration,
    -- | Specifies the transition rule for the lifecycle rule that describes when
    -- noncurrent objects transition to a specific storage class. If your
    -- bucket is versioning-enabled (or versioning is suspended), you can set
    -- this action to request that Amazon S3 transition noncurrent object
    -- versions to a specific storage class at a set period in the object\'s
    -- lifetime.
    LifecycleRule -> Maybe [NoncurrentVersionTransition]
noncurrentVersionTransitions :: Prelude.Maybe [NoncurrentVersionTransition],
    -- | Prefix identifying one or more objects to which the rule applies. This
    -- is no longer used; use @Filter@ instead.
    --
    -- Replacement must be made for object keys containing special characters
    -- (such as carriage returns) when using XML requests. For more
    -- information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/object-keys.html#object-key-xml-related-constraints XML related object key constraints>.
    LifecycleRule -> Maybe Text
prefix :: Prelude.Maybe Prelude.Text,
    -- | Specifies when an Amazon S3 object transitions to a specified storage
    -- class.
    LifecycleRule -> Maybe [Transition]
transitions :: Prelude.Maybe [Transition],
    -- | If \'Enabled\', the rule is currently being applied. If \'Disabled\',
    -- the rule is not currently being applied.
    LifecycleRule -> ExpirationStatus
status :: ExpirationStatus
  }
  deriving (LifecycleRule -> LifecycleRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LifecycleRule -> LifecycleRule -> Bool
$c/= :: LifecycleRule -> LifecycleRule -> Bool
== :: LifecycleRule -> LifecycleRule -> Bool
$c== :: LifecycleRule -> LifecycleRule -> Bool
Prelude.Eq, ReadPrec [LifecycleRule]
ReadPrec LifecycleRule
Int -> ReadS LifecycleRule
ReadS [LifecycleRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LifecycleRule]
$creadListPrec :: ReadPrec [LifecycleRule]
readPrec :: ReadPrec LifecycleRule
$creadPrec :: ReadPrec LifecycleRule
readList :: ReadS [LifecycleRule]
$creadList :: ReadS [LifecycleRule]
readsPrec :: Int -> ReadS LifecycleRule
$creadsPrec :: Int -> ReadS LifecycleRule
Prelude.Read, Int -> LifecycleRule -> ShowS
[LifecycleRule] -> ShowS
LifecycleRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LifecycleRule] -> ShowS
$cshowList :: [LifecycleRule] -> ShowS
show :: LifecycleRule -> String
$cshow :: LifecycleRule -> String
showsPrec :: Int -> LifecycleRule -> ShowS
$cshowsPrec :: Int -> LifecycleRule -> ShowS
Prelude.Show, forall x. Rep LifecycleRule x -> LifecycleRule
forall x. LifecycleRule -> Rep LifecycleRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LifecycleRule x -> LifecycleRule
$cfrom :: forall x. LifecycleRule -> Rep LifecycleRule x
Prelude.Generic)

-- |
-- Create a value of 'LifecycleRule' 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:
--
-- 'abortIncompleteMultipartUpload', 'lifecycleRule_abortIncompleteMultipartUpload' - Undocumented member.
--
-- 'expiration', 'lifecycleRule_expiration' - Specifies the expiration for the lifecycle of the object in the form of
-- date, days and, whether the object has a delete marker.
--
-- 'filter'', 'lifecycleRule_filter' - The @Filter@ is used to identify objects that a Lifecycle Rule applies
-- to. A @Filter@ must have exactly one of @Prefix@, @Tag@, or @And@
-- specified. @Filter@ is required if the @LifecycleRule@ does not contain
-- a @Prefix@ element.
--
-- 'id', 'lifecycleRule_id' - Unique identifier for the rule. The value cannot be longer than 255
-- characters.
--
-- 'noncurrentVersionExpiration', 'lifecycleRule_noncurrentVersionExpiration' - Undocumented member.
--
-- 'noncurrentVersionTransitions', 'lifecycleRule_noncurrentVersionTransitions' - Specifies the transition rule for the lifecycle rule that describes when
-- noncurrent objects transition to a specific storage class. If your
-- bucket is versioning-enabled (or versioning is suspended), you can set
-- this action to request that Amazon S3 transition noncurrent object
-- versions to a specific storage class at a set period in the object\'s
-- lifetime.
--
-- 'prefix', 'lifecycleRule_prefix' - Prefix identifying one or more objects to which the rule applies. This
-- is no longer used; use @Filter@ instead.
--
-- Replacement must be made for object keys containing special characters
-- (such as carriage returns) when using XML requests. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/object-keys.html#object-key-xml-related-constraints XML related object key constraints>.
--
-- 'transitions', 'lifecycleRule_transitions' - Specifies when an Amazon S3 object transitions to a specified storage
-- class.
--
-- 'status', 'lifecycleRule_status' - If \'Enabled\', the rule is currently being applied. If \'Disabled\',
-- the rule is not currently being applied.
newLifecycleRule ::
  -- | 'status'
  ExpirationStatus ->
  LifecycleRule
newLifecycleRule :: ExpirationStatus -> LifecycleRule
newLifecycleRule ExpirationStatus
pStatus_ =
  LifecycleRule'
    { $sel:abortIncompleteMultipartUpload:LifecycleRule' :: Maybe AbortIncompleteMultipartUpload
abortIncompleteMultipartUpload =
        forall a. Maybe a
Prelude.Nothing,
      $sel:expiration:LifecycleRule' :: Maybe LifecycleExpiration
expiration = forall a. Maybe a
Prelude.Nothing,
      $sel:filter':LifecycleRule' :: Maybe LifecycleRuleFilter
filter' = forall a. Maybe a
Prelude.Nothing,
      $sel:id:LifecycleRule' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:noncurrentVersionExpiration:LifecycleRule' :: Maybe NoncurrentVersionExpiration
noncurrentVersionExpiration = forall a. Maybe a
Prelude.Nothing,
      $sel:noncurrentVersionTransitions:LifecycleRule' :: Maybe [NoncurrentVersionTransition]
noncurrentVersionTransitions = forall a. Maybe a
Prelude.Nothing,
      $sel:prefix:LifecycleRule' :: Maybe Text
prefix = forall a. Maybe a
Prelude.Nothing,
      $sel:transitions:LifecycleRule' :: Maybe [Transition]
transitions = forall a. Maybe a
Prelude.Nothing,
      $sel:status:LifecycleRule' :: ExpirationStatus
status = ExpirationStatus
pStatus_
    }

-- | Undocumented member.
lifecycleRule_abortIncompleteMultipartUpload :: Lens.Lens' LifecycleRule (Prelude.Maybe AbortIncompleteMultipartUpload)
lifecycleRule_abortIncompleteMultipartUpload :: Lens' LifecycleRule (Maybe AbortIncompleteMultipartUpload)
lifecycleRule_abortIncompleteMultipartUpload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LifecycleRule' {Maybe AbortIncompleteMultipartUpload
abortIncompleteMultipartUpload :: Maybe AbortIncompleteMultipartUpload
$sel:abortIncompleteMultipartUpload:LifecycleRule' :: LifecycleRule -> Maybe AbortIncompleteMultipartUpload
abortIncompleteMultipartUpload} -> Maybe AbortIncompleteMultipartUpload
abortIncompleteMultipartUpload) (\s :: LifecycleRule
s@LifecycleRule' {} Maybe AbortIncompleteMultipartUpload
a -> LifecycleRule
s {$sel:abortIncompleteMultipartUpload:LifecycleRule' :: Maybe AbortIncompleteMultipartUpload
abortIncompleteMultipartUpload = Maybe AbortIncompleteMultipartUpload
a} :: LifecycleRule)

-- | Specifies the expiration for the lifecycle of the object in the form of
-- date, days and, whether the object has a delete marker.
lifecycleRule_expiration :: Lens.Lens' LifecycleRule (Prelude.Maybe LifecycleExpiration)
lifecycleRule_expiration :: Lens' LifecycleRule (Maybe LifecycleExpiration)
lifecycleRule_expiration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LifecycleRule' {Maybe LifecycleExpiration
expiration :: Maybe LifecycleExpiration
$sel:expiration:LifecycleRule' :: LifecycleRule -> Maybe LifecycleExpiration
expiration} -> Maybe LifecycleExpiration
expiration) (\s :: LifecycleRule
s@LifecycleRule' {} Maybe LifecycleExpiration
a -> LifecycleRule
s {$sel:expiration:LifecycleRule' :: Maybe LifecycleExpiration
expiration = Maybe LifecycleExpiration
a} :: LifecycleRule)

-- | The @Filter@ is used to identify objects that a Lifecycle Rule applies
-- to. A @Filter@ must have exactly one of @Prefix@, @Tag@, or @And@
-- specified. @Filter@ is required if the @LifecycleRule@ does not contain
-- a @Prefix@ element.
lifecycleRule_filter :: Lens.Lens' LifecycleRule (Prelude.Maybe LifecycleRuleFilter)
lifecycleRule_filter :: Lens' LifecycleRule (Maybe LifecycleRuleFilter)
lifecycleRule_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LifecycleRule' {Maybe LifecycleRuleFilter
filter' :: Maybe LifecycleRuleFilter
$sel:filter':LifecycleRule' :: LifecycleRule -> Maybe LifecycleRuleFilter
filter'} -> Maybe LifecycleRuleFilter
filter') (\s :: LifecycleRule
s@LifecycleRule' {} Maybe LifecycleRuleFilter
a -> LifecycleRule
s {$sel:filter':LifecycleRule' :: Maybe LifecycleRuleFilter
filter' = Maybe LifecycleRuleFilter
a} :: LifecycleRule)

-- | Unique identifier for the rule. The value cannot be longer than 255
-- characters.
lifecycleRule_id :: Lens.Lens' LifecycleRule (Prelude.Maybe Prelude.Text)
lifecycleRule_id :: Lens' LifecycleRule (Maybe Text)
lifecycleRule_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LifecycleRule' {Maybe Text
id :: Maybe Text
$sel:id:LifecycleRule' :: LifecycleRule -> Maybe Text
id} -> Maybe Text
id) (\s :: LifecycleRule
s@LifecycleRule' {} Maybe Text
a -> LifecycleRule
s {$sel:id:LifecycleRule' :: Maybe Text
id = Maybe Text
a} :: LifecycleRule)

-- | Undocumented member.
lifecycleRule_noncurrentVersionExpiration :: Lens.Lens' LifecycleRule (Prelude.Maybe NoncurrentVersionExpiration)
lifecycleRule_noncurrentVersionExpiration :: Lens' LifecycleRule (Maybe NoncurrentVersionExpiration)
lifecycleRule_noncurrentVersionExpiration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LifecycleRule' {Maybe NoncurrentVersionExpiration
noncurrentVersionExpiration :: Maybe NoncurrentVersionExpiration
$sel:noncurrentVersionExpiration:LifecycleRule' :: LifecycleRule -> Maybe NoncurrentVersionExpiration
noncurrentVersionExpiration} -> Maybe NoncurrentVersionExpiration
noncurrentVersionExpiration) (\s :: LifecycleRule
s@LifecycleRule' {} Maybe NoncurrentVersionExpiration
a -> LifecycleRule
s {$sel:noncurrentVersionExpiration:LifecycleRule' :: Maybe NoncurrentVersionExpiration
noncurrentVersionExpiration = Maybe NoncurrentVersionExpiration
a} :: LifecycleRule)

-- | Specifies the transition rule for the lifecycle rule that describes when
-- noncurrent objects transition to a specific storage class. If your
-- bucket is versioning-enabled (or versioning is suspended), you can set
-- this action to request that Amazon S3 transition noncurrent object
-- versions to a specific storage class at a set period in the object\'s
-- lifetime.
lifecycleRule_noncurrentVersionTransitions :: Lens.Lens' LifecycleRule (Prelude.Maybe [NoncurrentVersionTransition])
lifecycleRule_noncurrentVersionTransitions :: Lens' LifecycleRule (Maybe [NoncurrentVersionTransition])
lifecycleRule_noncurrentVersionTransitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LifecycleRule' {Maybe [NoncurrentVersionTransition]
noncurrentVersionTransitions :: Maybe [NoncurrentVersionTransition]
$sel:noncurrentVersionTransitions:LifecycleRule' :: LifecycleRule -> Maybe [NoncurrentVersionTransition]
noncurrentVersionTransitions} -> Maybe [NoncurrentVersionTransition]
noncurrentVersionTransitions) (\s :: LifecycleRule
s@LifecycleRule' {} Maybe [NoncurrentVersionTransition]
a -> LifecycleRule
s {$sel:noncurrentVersionTransitions:LifecycleRule' :: Maybe [NoncurrentVersionTransition]
noncurrentVersionTransitions = Maybe [NoncurrentVersionTransition]
a} :: LifecycleRule) 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

-- | Prefix identifying one or more objects to which the rule applies. This
-- is no longer used; use @Filter@ instead.
--
-- Replacement must be made for object keys containing special characters
-- (such as carriage returns) when using XML requests. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/object-keys.html#object-key-xml-related-constraints XML related object key constraints>.
lifecycleRule_prefix :: Lens.Lens' LifecycleRule (Prelude.Maybe Prelude.Text)
lifecycleRule_prefix :: Lens' LifecycleRule (Maybe Text)
lifecycleRule_prefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LifecycleRule' {Maybe Text
prefix :: Maybe Text
$sel:prefix:LifecycleRule' :: LifecycleRule -> Maybe Text
prefix} -> Maybe Text
prefix) (\s :: LifecycleRule
s@LifecycleRule' {} Maybe Text
a -> LifecycleRule
s {$sel:prefix:LifecycleRule' :: Maybe Text
prefix = Maybe Text
a} :: LifecycleRule)

-- | Specifies when an Amazon S3 object transitions to a specified storage
-- class.
lifecycleRule_transitions :: Lens.Lens' LifecycleRule (Prelude.Maybe [Transition])
lifecycleRule_transitions :: Lens' LifecycleRule (Maybe [Transition])
lifecycleRule_transitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LifecycleRule' {Maybe [Transition]
transitions :: Maybe [Transition]
$sel:transitions:LifecycleRule' :: LifecycleRule -> Maybe [Transition]
transitions} -> Maybe [Transition]
transitions) (\s :: LifecycleRule
s@LifecycleRule' {} Maybe [Transition]
a -> LifecycleRule
s {$sel:transitions:LifecycleRule' :: Maybe [Transition]
transitions = Maybe [Transition]
a} :: LifecycleRule) 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

-- | If \'Enabled\', the rule is currently being applied. If \'Disabled\',
-- the rule is not currently being applied.
lifecycleRule_status :: Lens.Lens' LifecycleRule ExpirationStatus
lifecycleRule_status :: Lens' LifecycleRule ExpirationStatus
lifecycleRule_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LifecycleRule' {ExpirationStatus
status :: ExpirationStatus
$sel:status:LifecycleRule' :: LifecycleRule -> ExpirationStatus
status} -> ExpirationStatus
status) (\s :: LifecycleRule
s@LifecycleRule' {} ExpirationStatus
a -> LifecycleRule
s {$sel:status:LifecycleRule' :: ExpirationStatus
status = ExpirationStatus
a} :: LifecycleRule)

instance Data.FromXML LifecycleRule where
  parseXML :: [Node] -> Either String LifecycleRule
parseXML [Node]
x =
    Maybe AbortIncompleteMultipartUpload
-> Maybe LifecycleExpiration
-> Maybe LifecycleRuleFilter
-> Maybe Text
-> Maybe NoncurrentVersionExpiration
-> Maybe [NoncurrentVersionTransition]
-> Maybe Text
-> Maybe [Transition]
-> ExpirationStatus
-> LifecycleRule
LifecycleRule'
      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
"AbortIncompleteMultipartUpload")
      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
"Expiration")
      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
"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
"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 (Maybe a)
Data..@? Text
"NoncurrentVersionExpiration")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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
"NoncurrentVersionTransition")
                      [Node]
x
                  )
      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
"Prefix")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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
"Transition") [Node]
x)
      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
"Status")

instance Prelude.Hashable LifecycleRule where
  hashWithSalt :: Int -> LifecycleRule -> Int
hashWithSalt Int
_salt LifecycleRule' {Maybe [Transition]
Maybe [NoncurrentVersionTransition]
Maybe Text
Maybe AbortIncompleteMultipartUpload
Maybe LifecycleExpiration
Maybe NoncurrentVersionExpiration
Maybe LifecycleRuleFilter
ExpirationStatus
status :: ExpirationStatus
transitions :: Maybe [Transition]
prefix :: Maybe Text
noncurrentVersionTransitions :: Maybe [NoncurrentVersionTransition]
noncurrentVersionExpiration :: Maybe NoncurrentVersionExpiration
id :: Maybe Text
filter' :: Maybe LifecycleRuleFilter
expiration :: Maybe LifecycleExpiration
abortIncompleteMultipartUpload :: Maybe AbortIncompleteMultipartUpload
$sel:status:LifecycleRule' :: LifecycleRule -> ExpirationStatus
$sel:transitions:LifecycleRule' :: LifecycleRule -> Maybe [Transition]
$sel:prefix:LifecycleRule' :: LifecycleRule -> Maybe Text
$sel:noncurrentVersionTransitions:LifecycleRule' :: LifecycleRule -> Maybe [NoncurrentVersionTransition]
$sel:noncurrentVersionExpiration:LifecycleRule' :: LifecycleRule -> Maybe NoncurrentVersionExpiration
$sel:id:LifecycleRule' :: LifecycleRule -> Maybe Text
$sel:filter':LifecycleRule' :: LifecycleRule -> Maybe LifecycleRuleFilter
$sel:expiration:LifecycleRule' :: LifecycleRule -> Maybe LifecycleExpiration
$sel:abortIncompleteMultipartUpload:LifecycleRule' :: LifecycleRule -> Maybe AbortIncompleteMultipartUpload
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AbortIncompleteMultipartUpload
abortIncompleteMultipartUpload
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LifecycleExpiration
expiration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LifecycleRuleFilter
filter'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NoncurrentVersionExpiration
noncurrentVersionExpiration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [NoncurrentVersionTransition]
noncurrentVersionTransitions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
prefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Transition]
transitions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ExpirationStatus
status

instance Prelude.NFData LifecycleRule where
  rnf :: LifecycleRule -> ()
rnf LifecycleRule' {Maybe [Transition]
Maybe [NoncurrentVersionTransition]
Maybe Text
Maybe AbortIncompleteMultipartUpload
Maybe LifecycleExpiration
Maybe NoncurrentVersionExpiration
Maybe LifecycleRuleFilter
ExpirationStatus
status :: ExpirationStatus
transitions :: Maybe [Transition]
prefix :: Maybe Text
noncurrentVersionTransitions :: Maybe [NoncurrentVersionTransition]
noncurrentVersionExpiration :: Maybe NoncurrentVersionExpiration
id :: Maybe Text
filter' :: Maybe LifecycleRuleFilter
expiration :: Maybe LifecycleExpiration
abortIncompleteMultipartUpload :: Maybe AbortIncompleteMultipartUpload
$sel:status:LifecycleRule' :: LifecycleRule -> ExpirationStatus
$sel:transitions:LifecycleRule' :: LifecycleRule -> Maybe [Transition]
$sel:prefix:LifecycleRule' :: LifecycleRule -> Maybe Text
$sel:noncurrentVersionTransitions:LifecycleRule' :: LifecycleRule -> Maybe [NoncurrentVersionTransition]
$sel:noncurrentVersionExpiration:LifecycleRule' :: LifecycleRule -> Maybe NoncurrentVersionExpiration
$sel:id:LifecycleRule' :: LifecycleRule -> Maybe Text
$sel:filter':LifecycleRule' :: LifecycleRule -> Maybe LifecycleRuleFilter
$sel:expiration:LifecycleRule' :: LifecycleRule -> Maybe LifecycleExpiration
$sel:abortIncompleteMultipartUpload:LifecycleRule' :: LifecycleRule -> Maybe AbortIncompleteMultipartUpload
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AbortIncompleteMultipartUpload
abortIncompleteMultipartUpload
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LifecycleExpiration
expiration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LifecycleRuleFilter
filter'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NoncurrentVersionExpiration
noncurrentVersionExpiration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [NoncurrentVersionTransition]
noncurrentVersionTransitions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
prefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Transition]
transitions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ExpirationStatus
status

instance Data.ToXML LifecycleRule where
  toXML :: LifecycleRule -> XML
toXML LifecycleRule' {Maybe [Transition]
Maybe [NoncurrentVersionTransition]
Maybe Text
Maybe AbortIncompleteMultipartUpload
Maybe LifecycleExpiration
Maybe NoncurrentVersionExpiration
Maybe LifecycleRuleFilter
ExpirationStatus
status :: ExpirationStatus
transitions :: Maybe [Transition]
prefix :: Maybe Text
noncurrentVersionTransitions :: Maybe [NoncurrentVersionTransition]
noncurrentVersionExpiration :: Maybe NoncurrentVersionExpiration
id :: Maybe Text
filter' :: Maybe LifecycleRuleFilter
expiration :: Maybe LifecycleExpiration
abortIncompleteMultipartUpload :: Maybe AbortIncompleteMultipartUpload
$sel:status:LifecycleRule' :: LifecycleRule -> ExpirationStatus
$sel:transitions:LifecycleRule' :: LifecycleRule -> Maybe [Transition]
$sel:prefix:LifecycleRule' :: LifecycleRule -> Maybe Text
$sel:noncurrentVersionTransitions:LifecycleRule' :: LifecycleRule -> Maybe [NoncurrentVersionTransition]
$sel:noncurrentVersionExpiration:LifecycleRule' :: LifecycleRule -> Maybe NoncurrentVersionExpiration
$sel:id:LifecycleRule' :: LifecycleRule -> Maybe Text
$sel:filter':LifecycleRule' :: LifecycleRule -> Maybe LifecycleRuleFilter
$sel:expiration:LifecycleRule' :: LifecycleRule -> Maybe LifecycleExpiration
$sel:abortIncompleteMultipartUpload:LifecycleRule' :: LifecycleRule -> Maybe AbortIncompleteMultipartUpload
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"AbortIncompleteMultipartUpload"
          forall a. ToXML a => Name -> a -> XML
Data.@= Maybe AbortIncompleteMultipartUpload
abortIncompleteMultipartUpload,
        Name
"Expiration" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe LifecycleExpiration
expiration,
        Name
"Filter" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe LifecycleRuleFilter
filter',
        Name
"ID" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Text
id,
        Name
"NoncurrentVersionExpiration"
          forall a. ToXML a => Name -> a -> XML
Data.@= Maybe NoncurrentVersionExpiration
noncurrentVersionExpiration,
        forall a. ToXML a => a -> XML
Data.toXML
          ( forall a. (IsList a, ToXML (Item a)) => Name -> a -> XML
Data.toXMLList Name
"NoncurrentVersionTransition"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [NoncurrentVersionTransition]
noncurrentVersionTransitions
          ),
        Name
"Prefix" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Text
prefix,
        forall a. ToXML a => a -> XML
Data.toXML
          ( forall a. (IsList a, ToXML (Item a)) => Name -> a -> XML
Data.toXMLList Name
"Transition"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Transition]
transitions
          ),
        Name
"Status" forall a. ToXML a => Name -> a -> XML
Data.@= ExpirationStatus
status
      ]