{-# 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.FSx.Types.Backup
-- 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.FSx.Types.Backup where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.FSx.Types.ActiveDirectoryBackupAttributes
import Amazonka.FSx.Types.BackupFailureDetails
import Amazonka.FSx.Types.BackupLifecycle
import Amazonka.FSx.Types.BackupType
import Amazonka.FSx.Types.FileSystem
import Amazonka.FSx.Types.ResourceType
import Amazonka.FSx.Types.Tag
import Amazonka.FSx.Types.Volume
import qualified Amazonka.Prelude as Prelude

-- | A backup of an Amazon FSx for Windows File Server, Amazon FSx for Lustre
-- file system, Amazon FSx for NetApp ONTAP volume, or Amazon FSx for
-- OpenZFS file system.
--
-- /See:/ 'newBackup' smart constructor.
data Backup = Backup'
  { -- | The configuration of the self-managed Microsoft Active Directory
    -- directory to which the Windows File Server instance is joined.
    Backup -> Maybe ActiveDirectoryBackupAttributes
directoryInformation :: Prelude.Maybe ActiveDirectoryBackupAttributes,
    -- | Details explaining any failures that occurred when creating a backup.
    Backup -> Maybe BackupFailureDetails
failureDetails :: Prelude.Maybe BackupFailureDetails,
    -- | The ID of the Key Management Service (KMS) key used to encrypt the
    -- backup of the Amazon FSx file system\'s data at rest.
    Backup -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    Backup -> Maybe Text
ownerId :: Prelude.Maybe Prelude.Text,
    Backup -> Maybe Natural
progressPercent :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon Resource Name (ARN) for the backup resource.
    Backup -> Maybe Text
resourceARN :: Prelude.Maybe Prelude.Text,
    -- | Specifies the resource type that\'s backed up.
    Backup -> Maybe ResourceType
resourceType :: Prelude.Maybe ResourceType,
    Backup -> Maybe Text
sourceBackupId :: Prelude.Maybe Prelude.Text,
    -- | The source Region of the backup. Specifies the Region from where this
    -- backup is copied.
    Backup -> Maybe Text
sourceBackupRegion :: Prelude.Maybe Prelude.Text,
    -- | The tags associated with a particular file system.
    Backup -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    Backup -> Maybe Volume
volume :: Prelude.Maybe Volume,
    -- | The ID of the backup.
    Backup -> Text
backupId :: Prelude.Text,
    -- | The lifecycle status of the backup.
    --
    -- -   @AVAILABLE@ - The backup is fully available.
    --
    -- -   @PENDING@ - For user-initiated backups on Lustre file systems only;
    --     Amazon FSx hasn\'t started creating the backup.
    --
    -- -   @CREATING@ - Amazon FSx is creating the backup.
    --
    -- -   @TRANSFERRING@ - For user-initiated backups on Lustre file systems
    --     only; Amazon FSx is transferring the backup to Amazon S3.
    --
    -- -   @COPYING@ - Amazon FSx is copying the backup.
    --
    -- -   @DELETED@ - Amazon FSx deleted the backup and it\'s no longer
    --     available.
    --
    -- -   @FAILED@ - Amazon FSx couldn\'t finish the backup.
    Backup -> BackupLifecycle
lifecycle :: BackupLifecycle,
    -- | The type of the file-system backup.
    Backup -> BackupType
type' :: BackupType,
    -- | The time when a particular backup was created.
    Backup -> POSIX
creationTime :: Data.POSIX,
    -- | The metadata of the file system associated with the backup. This
    -- metadata is persisted even if the file system is deleted.
    Backup -> FileSystem
fileSystem :: FileSystem
  }
  deriving (Backup -> Backup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Backup -> Backup -> Bool
$c/= :: Backup -> Backup -> Bool
== :: Backup -> Backup -> Bool
$c== :: Backup -> Backup -> Bool
Prelude.Eq, ReadPrec [Backup]
ReadPrec Backup
Int -> ReadS Backup
ReadS [Backup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Backup]
$creadListPrec :: ReadPrec [Backup]
readPrec :: ReadPrec Backup
$creadPrec :: ReadPrec Backup
readList :: ReadS [Backup]
$creadList :: ReadS [Backup]
readsPrec :: Int -> ReadS Backup
$creadsPrec :: Int -> ReadS Backup
Prelude.Read, Int -> Backup -> ShowS
[Backup] -> ShowS
Backup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Backup] -> ShowS
$cshowList :: [Backup] -> ShowS
show :: Backup -> String
$cshow :: Backup -> String
showsPrec :: Int -> Backup -> ShowS
$cshowsPrec :: Int -> Backup -> ShowS
Prelude.Show, forall x. Rep Backup x -> Backup
forall x. Backup -> Rep Backup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Backup x -> Backup
$cfrom :: forall x. Backup -> Rep Backup x
Prelude.Generic)

-- |
-- Create a value of 'Backup' 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:
--
-- 'directoryInformation', 'backup_directoryInformation' - The configuration of the self-managed Microsoft Active Directory
-- directory to which the Windows File Server instance is joined.
--
-- 'failureDetails', 'backup_failureDetails' - Details explaining any failures that occurred when creating a backup.
--
-- 'kmsKeyId', 'backup_kmsKeyId' - The ID of the Key Management Service (KMS) key used to encrypt the
-- backup of the Amazon FSx file system\'s data at rest.
--
-- 'ownerId', 'backup_ownerId' - Undocumented member.
--
-- 'progressPercent', 'backup_progressPercent' - Undocumented member.
--
-- 'resourceARN', 'backup_resourceARN' - The Amazon Resource Name (ARN) for the backup resource.
--
-- 'resourceType', 'backup_resourceType' - Specifies the resource type that\'s backed up.
--
-- 'sourceBackupId', 'backup_sourceBackupId' - Undocumented member.
--
-- 'sourceBackupRegion', 'backup_sourceBackupRegion' - The source Region of the backup. Specifies the Region from where this
-- backup is copied.
--
-- 'tags', 'backup_tags' - The tags associated with a particular file system.
--
-- 'volume', 'backup_volume' - Undocumented member.
--
-- 'backupId', 'backup_backupId' - The ID of the backup.
--
-- 'lifecycle', 'backup_lifecycle' - The lifecycle status of the backup.
--
-- -   @AVAILABLE@ - The backup is fully available.
--
-- -   @PENDING@ - For user-initiated backups on Lustre file systems only;
--     Amazon FSx hasn\'t started creating the backup.
--
-- -   @CREATING@ - Amazon FSx is creating the backup.
--
-- -   @TRANSFERRING@ - For user-initiated backups on Lustre file systems
--     only; Amazon FSx is transferring the backup to Amazon S3.
--
-- -   @COPYING@ - Amazon FSx is copying the backup.
--
-- -   @DELETED@ - Amazon FSx deleted the backup and it\'s no longer
--     available.
--
-- -   @FAILED@ - Amazon FSx couldn\'t finish the backup.
--
-- 'type'', 'backup_type' - The type of the file-system backup.
--
-- 'creationTime', 'backup_creationTime' - The time when a particular backup was created.
--
-- 'fileSystem', 'backup_fileSystem' - The metadata of the file system associated with the backup. This
-- metadata is persisted even if the file system is deleted.
newBackup ::
  -- | 'backupId'
  Prelude.Text ->
  -- | 'lifecycle'
  BackupLifecycle ->
  -- | 'type''
  BackupType ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'fileSystem'
  FileSystem ->
  Backup
newBackup :: Text
-> BackupLifecycle -> BackupType -> UTCTime -> FileSystem -> Backup
newBackup
  Text
pBackupId_
  BackupLifecycle
pLifecycle_
  BackupType
pType_
  UTCTime
pCreationTime_
  FileSystem
pFileSystem_ =
    Backup'
      { $sel:directoryInformation:Backup' :: Maybe ActiveDirectoryBackupAttributes
directoryInformation = forall a. Maybe a
Prelude.Nothing,
        $sel:failureDetails:Backup' :: Maybe BackupFailureDetails
failureDetails = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:Backup' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:ownerId:Backup' :: Maybe Text
ownerId = forall a. Maybe a
Prelude.Nothing,
        $sel:progressPercent:Backup' :: Maybe Natural
progressPercent = forall a. Maybe a
Prelude.Nothing,
        $sel:resourceARN:Backup' :: Maybe Text
resourceARN = forall a. Maybe a
Prelude.Nothing,
        $sel:resourceType:Backup' :: Maybe ResourceType
resourceType = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceBackupId:Backup' :: Maybe Text
sourceBackupId = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceBackupRegion:Backup' :: Maybe Text
sourceBackupRegion = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:Backup' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:volume:Backup' :: Maybe Volume
volume = forall a. Maybe a
Prelude.Nothing,
        $sel:backupId:Backup' :: Text
backupId = Text
pBackupId_,
        $sel:lifecycle:Backup' :: BackupLifecycle
lifecycle = BackupLifecycle
pLifecycle_,
        $sel:type':Backup' :: BackupType
type' = BackupType
pType_,
        $sel:creationTime:Backup' :: POSIX
creationTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:fileSystem:Backup' :: FileSystem
fileSystem = FileSystem
pFileSystem_
      }

-- | The configuration of the self-managed Microsoft Active Directory
-- directory to which the Windows File Server instance is joined.
backup_directoryInformation :: Lens.Lens' Backup (Prelude.Maybe ActiveDirectoryBackupAttributes)
backup_directoryInformation :: Lens' Backup (Maybe ActiveDirectoryBackupAttributes)
backup_directoryInformation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {Maybe ActiveDirectoryBackupAttributes
directoryInformation :: Maybe ActiveDirectoryBackupAttributes
$sel:directoryInformation:Backup' :: Backup -> Maybe ActiveDirectoryBackupAttributes
directoryInformation} -> Maybe ActiveDirectoryBackupAttributes
directoryInformation) (\s :: Backup
s@Backup' {} Maybe ActiveDirectoryBackupAttributes
a -> Backup
s {$sel:directoryInformation:Backup' :: Maybe ActiveDirectoryBackupAttributes
directoryInformation = Maybe ActiveDirectoryBackupAttributes
a} :: Backup)

-- | Details explaining any failures that occurred when creating a backup.
backup_failureDetails :: Lens.Lens' Backup (Prelude.Maybe BackupFailureDetails)
backup_failureDetails :: Lens' Backup (Maybe BackupFailureDetails)
backup_failureDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {Maybe BackupFailureDetails
failureDetails :: Maybe BackupFailureDetails
$sel:failureDetails:Backup' :: Backup -> Maybe BackupFailureDetails
failureDetails} -> Maybe BackupFailureDetails
failureDetails) (\s :: Backup
s@Backup' {} Maybe BackupFailureDetails
a -> Backup
s {$sel:failureDetails:Backup' :: Maybe BackupFailureDetails
failureDetails = Maybe BackupFailureDetails
a} :: Backup)

-- | The ID of the Key Management Service (KMS) key used to encrypt the
-- backup of the Amazon FSx file system\'s data at rest.
backup_kmsKeyId :: Lens.Lens' Backup (Prelude.Maybe Prelude.Text)
backup_kmsKeyId :: Lens' Backup (Maybe Text)
backup_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:Backup' :: Backup -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: Backup
s@Backup' {} Maybe Text
a -> Backup
s {$sel:kmsKeyId:Backup' :: Maybe Text
kmsKeyId = Maybe Text
a} :: Backup)

-- | Undocumented member.
backup_ownerId :: Lens.Lens' Backup (Prelude.Maybe Prelude.Text)
backup_ownerId :: Lens' Backup (Maybe Text)
backup_ownerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {Maybe Text
ownerId :: Maybe Text
$sel:ownerId:Backup' :: Backup -> Maybe Text
ownerId} -> Maybe Text
ownerId) (\s :: Backup
s@Backup' {} Maybe Text
a -> Backup
s {$sel:ownerId:Backup' :: Maybe Text
ownerId = Maybe Text
a} :: Backup)

-- | Undocumented member.
backup_progressPercent :: Lens.Lens' Backup (Prelude.Maybe Prelude.Natural)
backup_progressPercent :: Lens' Backup (Maybe Natural)
backup_progressPercent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {Maybe Natural
progressPercent :: Maybe Natural
$sel:progressPercent:Backup' :: Backup -> Maybe Natural
progressPercent} -> Maybe Natural
progressPercent) (\s :: Backup
s@Backup' {} Maybe Natural
a -> Backup
s {$sel:progressPercent:Backup' :: Maybe Natural
progressPercent = Maybe Natural
a} :: Backup)

-- | The Amazon Resource Name (ARN) for the backup resource.
backup_resourceARN :: Lens.Lens' Backup (Prelude.Maybe Prelude.Text)
backup_resourceARN :: Lens' Backup (Maybe Text)
backup_resourceARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {Maybe Text
resourceARN :: Maybe Text
$sel:resourceARN:Backup' :: Backup -> Maybe Text
resourceARN} -> Maybe Text
resourceARN) (\s :: Backup
s@Backup' {} Maybe Text
a -> Backup
s {$sel:resourceARN:Backup' :: Maybe Text
resourceARN = Maybe Text
a} :: Backup)

-- | Specifies the resource type that\'s backed up.
backup_resourceType :: Lens.Lens' Backup (Prelude.Maybe ResourceType)
backup_resourceType :: Lens' Backup (Maybe ResourceType)
backup_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {Maybe ResourceType
resourceType :: Maybe ResourceType
$sel:resourceType:Backup' :: Backup -> Maybe ResourceType
resourceType} -> Maybe ResourceType
resourceType) (\s :: Backup
s@Backup' {} Maybe ResourceType
a -> Backup
s {$sel:resourceType:Backup' :: Maybe ResourceType
resourceType = Maybe ResourceType
a} :: Backup)

-- | Undocumented member.
backup_sourceBackupId :: Lens.Lens' Backup (Prelude.Maybe Prelude.Text)
backup_sourceBackupId :: Lens' Backup (Maybe Text)
backup_sourceBackupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {Maybe Text
sourceBackupId :: Maybe Text
$sel:sourceBackupId:Backup' :: Backup -> Maybe Text
sourceBackupId} -> Maybe Text
sourceBackupId) (\s :: Backup
s@Backup' {} Maybe Text
a -> Backup
s {$sel:sourceBackupId:Backup' :: Maybe Text
sourceBackupId = Maybe Text
a} :: Backup)

-- | The source Region of the backup. Specifies the Region from where this
-- backup is copied.
backup_sourceBackupRegion :: Lens.Lens' Backup (Prelude.Maybe Prelude.Text)
backup_sourceBackupRegion :: Lens' Backup (Maybe Text)
backup_sourceBackupRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {Maybe Text
sourceBackupRegion :: Maybe Text
$sel:sourceBackupRegion:Backup' :: Backup -> Maybe Text
sourceBackupRegion} -> Maybe Text
sourceBackupRegion) (\s :: Backup
s@Backup' {} Maybe Text
a -> Backup
s {$sel:sourceBackupRegion:Backup' :: Maybe Text
sourceBackupRegion = Maybe Text
a} :: Backup)

-- | The tags associated with a particular file system.
backup_tags :: Lens.Lens' Backup (Prelude.Maybe (Prelude.NonEmpty Tag))
backup_tags :: Lens' Backup (Maybe (NonEmpty Tag))
backup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:Backup' :: Backup -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: Backup
s@Backup' {} Maybe (NonEmpty Tag)
a -> Backup
s {$sel:tags:Backup' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: Backup) 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

-- | Undocumented member.
backup_volume :: Lens.Lens' Backup (Prelude.Maybe Volume)
backup_volume :: Lens' Backup (Maybe Volume)
backup_volume = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {Maybe Volume
volume :: Maybe Volume
$sel:volume:Backup' :: Backup -> Maybe Volume
volume} -> Maybe Volume
volume) (\s :: Backup
s@Backup' {} Maybe Volume
a -> Backup
s {$sel:volume:Backup' :: Maybe Volume
volume = Maybe Volume
a} :: Backup)

-- | The ID of the backup.
backup_backupId :: Lens.Lens' Backup Prelude.Text
backup_backupId :: Lens' Backup Text
backup_backupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {Text
backupId :: Text
$sel:backupId:Backup' :: Backup -> Text
backupId} -> Text
backupId) (\s :: Backup
s@Backup' {} Text
a -> Backup
s {$sel:backupId:Backup' :: Text
backupId = Text
a} :: Backup)

-- | The lifecycle status of the backup.
--
-- -   @AVAILABLE@ - The backup is fully available.
--
-- -   @PENDING@ - For user-initiated backups on Lustre file systems only;
--     Amazon FSx hasn\'t started creating the backup.
--
-- -   @CREATING@ - Amazon FSx is creating the backup.
--
-- -   @TRANSFERRING@ - For user-initiated backups on Lustre file systems
--     only; Amazon FSx is transferring the backup to Amazon S3.
--
-- -   @COPYING@ - Amazon FSx is copying the backup.
--
-- -   @DELETED@ - Amazon FSx deleted the backup and it\'s no longer
--     available.
--
-- -   @FAILED@ - Amazon FSx couldn\'t finish the backup.
backup_lifecycle :: Lens.Lens' Backup BackupLifecycle
backup_lifecycle :: Lens' Backup BackupLifecycle
backup_lifecycle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {BackupLifecycle
lifecycle :: BackupLifecycle
$sel:lifecycle:Backup' :: Backup -> BackupLifecycle
lifecycle} -> BackupLifecycle
lifecycle) (\s :: Backup
s@Backup' {} BackupLifecycle
a -> Backup
s {$sel:lifecycle:Backup' :: BackupLifecycle
lifecycle = BackupLifecycle
a} :: Backup)

-- | The type of the file-system backup.
backup_type :: Lens.Lens' Backup BackupType
backup_type :: Lens' Backup BackupType
backup_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {BackupType
type' :: BackupType
$sel:type':Backup' :: Backup -> BackupType
type'} -> BackupType
type') (\s :: Backup
s@Backup' {} BackupType
a -> Backup
s {$sel:type':Backup' :: BackupType
type' = BackupType
a} :: Backup)

-- | The time when a particular backup was created.
backup_creationTime :: Lens.Lens' Backup Prelude.UTCTime
backup_creationTime :: Lens' Backup UTCTime
backup_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {POSIX
creationTime :: POSIX
$sel:creationTime:Backup' :: Backup -> POSIX
creationTime} -> POSIX
creationTime) (\s :: Backup
s@Backup' {} POSIX
a -> Backup
s {$sel:creationTime:Backup' :: POSIX
creationTime = POSIX
a} :: Backup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The metadata of the file system associated with the backup. This
-- metadata is persisted even if the file system is deleted.
backup_fileSystem :: Lens.Lens' Backup FileSystem
backup_fileSystem :: Lens' Backup FileSystem
backup_fileSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Backup' {FileSystem
fileSystem :: FileSystem
$sel:fileSystem:Backup' :: Backup -> FileSystem
fileSystem} -> FileSystem
fileSystem) (\s :: Backup
s@Backup' {} FileSystem
a -> Backup
s {$sel:fileSystem:Backup' :: FileSystem
fileSystem = FileSystem
a} :: Backup)

instance Data.FromJSON Backup where
  parseJSON :: Value -> Parser Backup
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Backup"
      ( \Object
x ->
          Maybe ActiveDirectoryBackupAttributes
-> Maybe BackupFailureDetails
-> Maybe Text
-> Maybe Text
-> Maybe Natural
-> Maybe Text
-> Maybe ResourceType
-> Maybe Text
-> Maybe Text
-> Maybe (NonEmpty Tag)
-> Maybe Volume
-> Text
-> BackupLifecycle
-> BackupType
-> POSIX
-> FileSystem
-> Backup
Backup'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"DirectoryInformation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"FailureDetails")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"KmsKeyId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"OwnerId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ProgressPercent")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ResourceARN")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ResourceType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SourceBackupId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SourceBackupRegion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Tags")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Volume")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"BackupId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Lifecycle")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Type")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"CreationTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"FileSystem")
      )

instance Prelude.Hashable Backup where
  hashWithSalt :: Int -> Backup -> Int
hashWithSalt Int
_salt Backup' {Maybe Natural
Maybe (NonEmpty Tag)
Maybe Text
Maybe ActiveDirectoryBackupAttributes
Maybe BackupFailureDetails
Maybe ResourceType
Maybe Volume
Text
POSIX
BackupLifecycle
BackupType
FileSystem
fileSystem :: FileSystem
creationTime :: POSIX
type' :: BackupType
lifecycle :: BackupLifecycle
backupId :: Text
volume :: Maybe Volume
tags :: Maybe (NonEmpty Tag)
sourceBackupRegion :: Maybe Text
sourceBackupId :: Maybe Text
resourceType :: Maybe ResourceType
resourceARN :: Maybe Text
progressPercent :: Maybe Natural
ownerId :: Maybe Text
kmsKeyId :: Maybe Text
failureDetails :: Maybe BackupFailureDetails
directoryInformation :: Maybe ActiveDirectoryBackupAttributes
$sel:fileSystem:Backup' :: Backup -> FileSystem
$sel:creationTime:Backup' :: Backup -> POSIX
$sel:type':Backup' :: Backup -> BackupType
$sel:lifecycle:Backup' :: Backup -> BackupLifecycle
$sel:backupId:Backup' :: Backup -> Text
$sel:volume:Backup' :: Backup -> Maybe Volume
$sel:tags:Backup' :: Backup -> Maybe (NonEmpty Tag)
$sel:sourceBackupRegion:Backup' :: Backup -> Maybe Text
$sel:sourceBackupId:Backup' :: Backup -> Maybe Text
$sel:resourceType:Backup' :: Backup -> Maybe ResourceType
$sel:resourceARN:Backup' :: Backup -> Maybe Text
$sel:progressPercent:Backup' :: Backup -> Maybe Natural
$sel:ownerId:Backup' :: Backup -> Maybe Text
$sel:kmsKeyId:Backup' :: Backup -> Maybe Text
$sel:failureDetails:Backup' :: Backup -> Maybe BackupFailureDetails
$sel:directoryInformation:Backup' :: Backup -> Maybe ActiveDirectoryBackupAttributes
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ActiveDirectoryBackupAttributes
directoryInformation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BackupFailureDetails
failureDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ownerId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
progressPercent
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resourceARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResourceType
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceBackupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceBackupRegion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Volume
volume
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
backupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BackupLifecycle
lifecycle
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BackupType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
creationTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FileSystem
fileSystem

instance Prelude.NFData Backup where
  rnf :: Backup -> ()
rnf Backup' {Maybe Natural
Maybe (NonEmpty Tag)
Maybe Text
Maybe ActiveDirectoryBackupAttributes
Maybe BackupFailureDetails
Maybe ResourceType
Maybe Volume
Text
POSIX
BackupLifecycle
BackupType
FileSystem
fileSystem :: FileSystem
creationTime :: POSIX
type' :: BackupType
lifecycle :: BackupLifecycle
backupId :: Text
volume :: Maybe Volume
tags :: Maybe (NonEmpty Tag)
sourceBackupRegion :: Maybe Text
sourceBackupId :: Maybe Text
resourceType :: Maybe ResourceType
resourceARN :: Maybe Text
progressPercent :: Maybe Natural
ownerId :: Maybe Text
kmsKeyId :: Maybe Text
failureDetails :: Maybe BackupFailureDetails
directoryInformation :: Maybe ActiveDirectoryBackupAttributes
$sel:fileSystem:Backup' :: Backup -> FileSystem
$sel:creationTime:Backup' :: Backup -> POSIX
$sel:type':Backup' :: Backup -> BackupType
$sel:lifecycle:Backup' :: Backup -> BackupLifecycle
$sel:backupId:Backup' :: Backup -> Text
$sel:volume:Backup' :: Backup -> Maybe Volume
$sel:tags:Backup' :: Backup -> Maybe (NonEmpty Tag)
$sel:sourceBackupRegion:Backup' :: Backup -> Maybe Text
$sel:sourceBackupId:Backup' :: Backup -> Maybe Text
$sel:resourceType:Backup' :: Backup -> Maybe ResourceType
$sel:resourceARN:Backup' :: Backup -> Maybe Text
$sel:progressPercent:Backup' :: Backup -> Maybe Natural
$sel:ownerId:Backup' :: Backup -> Maybe Text
$sel:kmsKeyId:Backup' :: Backup -> Maybe Text
$sel:failureDetails:Backup' :: Backup -> Maybe BackupFailureDetails
$sel:directoryInformation:Backup' :: Backup -> Maybe ActiveDirectoryBackupAttributes
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ActiveDirectoryBackupAttributes
directoryInformation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BackupFailureDetails
failureDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ownerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
progressPercent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceBackupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceBackupRegion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Volume
volume
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
backupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BackupLifecycle
lifecycle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BackupType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FileSystem
fileSystem