{-# 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.LustreFileSystemConfiguration
-- 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.LustreFileSystemConfiguration 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.DataCompressionType
import Amazonka.FSx.Types.DataRepositoryConfiguration
import Amazonka.FSx.Types.DriveCacheType
import Amazonka.FSx.Types.LustreDeploymentType
import Amazonka.FSx.Types.LustreLogConfiguration
import Amazonka.FSx.Types.LustreRootSquashConfiguration
import qualified Amazonka.Prelude as Prelude

-- | The configuration for the Amazon FSx for Lustre file system.
--
-- /See:/ 'newLustreFileSystemConfiguration' smart constructor.
data LustreFileSystemConfiguration = LustreFileSystemConfiguration'
  { LustreFileSystemConfiguration -> Maybe Natural
automaticBackupRetentionDays :: Prelude.Maybe Prelude.Natural,
    -- | A boolean flag indicating whether tags on the file system are copied to
    -- backups. If it\'s set to true, all tags on the file system are copied to
    -- all automatic backups and any user-initiated backups where the user
    -- doesn\'t specify any tags. If this value is true, and you specify one or
    -- more tags, only the specified tags are copied to backups. If you specify
    -- one or more tags when creating a user-initiated backup, no tags are
    -- copied from the file system, regardless of this value. (Default = false)
    LustreFileSystemConfiguration -> Maybe Bool
copyTagsToBackups :: Prelude.Maybe Prelude.Bool,
    LustreFileSystemConfiguration -> Maybe Text
dailyAutomaticBackupStartTime :: Prelude.Maybe Prelude.Text,
    -- | The data compression configuration for the file system.
    -- @DataCompressionType@ can have the following values:
    --
    -- -   @NONE@ - Data compression is turned off for the file system.
    --
    -- -   @LZ4@ - Data compression is turned on with the LZ4 algorithm.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/data-compression.html Lustre data compression>.
    LustreFileSystemConfiguration -> Maybe DataCompressionType
dataCompressionType :: Prelude.Maybe DataCompressionType,
    LustreFileSystemConfiguration -> Maybe DataRepositoryConfiguration
dataRepositoryConfiguration :: Prelude.Maybe DataRepositoryConfiguration,
    -- | The deployment type of the FSx for Lustre file system. /Scratch
    -- deployment type/ is designed for temporary storage and shorter-term
    -- processing of data.
    --
    -- @SCRATCH_1@ and @SCRATCH_2@ deployment types are best suited for when
    -- you need temporary storage and shorter-term processing of data. The
    -- @SCRATCH_2@ deployment type provides in-transit encryption of data and
    -- higher burst throughput capacity than @SCRATCH_1@.
    --
    -- The @PERSISTENT_1@ and @PERSISTENT_2@ deployment type is used for
    -- longer-term storage and workloads and encryption of data in transit.
    -- @PERSISTENT_2@ is built on Lustre v2.12 and offers higher
    -- @PerUnitStorageThroughput@ (up to 1000 MB\/s\/TiB) along with a lower
    -- minimum storage capacity requirement (600 GiB). To learn more about FSx
    -- for Lustre deployment types, see
    -- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/lustre-deployment-types.html FSx for Lustre deployment options>.
    --
    -- The default is @SCRATCH_1@.
    LustreFileSystemConfiguration -> Maybe LustreDeploymentType
deploymentType :: Prelude.Maybe LustreDeploymentType,
    -- | The type of drive cache used by @PERSISTENT_1@ file systems that are
    -- provisioned with HDD storage devices. This parameter is required when
    -- @StorageType@ is HDD. When set to @READ@ the file system has an SSD
    -- storage cache that is sized to 20% of the file system\'s storage
    -- capacity. This improves the performance for frequently accessed files by
    -- caching up to 20% of the total storage capacity.
    --
    -- This parameter is required when @StorageType@ is set to HDD.
    LustreFileSystemConfiguration -> Maybe DriveCacheType
driveCacheType :: Prelude.Maybe DriveCacheType,
    -- | The Lustre logging configuration. Lustre logging writes the enabled log
    -- events for your file system to Amazon CloudWatch Logs.
    LustreFileSystemConfiguration -> Maybe LustreLogConfiguration
logConfiguration :: Prelude.Maybe LustreLogConfiguration,
    -- | You use the @MountName@ value when mounting the file system.
    --
    -- For the @SCRATCH_1@ deployment type, this value is always \"@fsx@\". For
    -- @SCRATCH_2@, @PERSISTENT_1@, and @PERSISTENT_2@ deployment types, this
    -- value is a string that is unique within an Amazon Web Services Region.
    LustreFileSystemConfiguration -> Maybe Text
mountName :: Prelude.Maybe Prelude.Text,
    -- | Per unit storage throughput represents the megabytes per second of read
    -- or write throughput per 1 tebibyte of storage provisioned. File system
    -- throughput capacity is equal to Storage capacity (TiB) *
    -- PerUnitStorageThroughput (MB\/s\/TiB). This option is only valid for
    -- @PERSISTENT_1@ and @PERSISTENT_2@ deployment types.
    --
    -- Valid values:
    --
    -- -   For @PERSISTENT_1@ SSD storage: 50, 100, 200.
    --
    -- -   For @PERSISTENT_1@ HDD storage: 12, 40.
    --
    -- -   For @PERSISTENT_2@ SSD storage: 125, 250, 500, 1000.
    LustreFileSystemConfiguration -> Maybe Natural
perUnitStorageThroughput :: Prelude.Maybe Prelude.Natural,
    -- | The Lustre root squash configuration for an Amazon FSx for Lustre file
    -- system. When enabled, root squash restricts root-level access from
    -- clients that try to access your file system as a root user.
    LustreFileSystemConfiguration
-> Maybe LustreRootSquashConfiguration
rootSquashConfiguration :: Prelude.Maybe LustreRootSquashConfiguration,
    -- | The preferred start time to perform weekly maintenance, formatted
    -- d:HH:MM in the UTC time zone. Here, @d@ is the weekday number, from 1
    -- through 7, beginning with Monday and ending with Sunday.
    LustreFileSystemConfiguration -> Maybe Text
weeklyMaintenanceStartTime :: Prelude.Maybe Prelude.Text
  }
  deriving (LustreFileSystemConfiguration
-> LustreFileSystemConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LustreFileSystemConfiguration
-> LustreFileSystemConfiguration -> Bool
$c/= :: LustreFileSystemConfiguration
-> LustreFileSystemConfiguration -> Bool
== :: LustreFileSystemConfiguration
-> LustreFileSystemConfiguration -> Bool
$c== :: LustreFileSystemConfiguration
-> LustreFileSystemConfiguration -> Bool
Prelude.Eq, ReadPrec [LustreFileSystemConfiguration]
ReadPrec LustreFileSystemConfiguration
Int -> ReadS LustreFileSystemConfiguration
ReadS [LustreFileSystemConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LustreFileSystemConfiguration]
$creadListPrec :: ReadPrec [LustreFileSystemConfiguration]
readPrec :: ReadPrec LustreFileSystemConfiguration
$creadPrec :: ReadPrec LustreFileSystemConfiguration
readList :: ReadS [LustreFileSystemConfiguration]
$creadList :: ReadS [LustreFileSystemConfiguration]
readsPrec :: Int -> ReadS LustreFileSystemConfiguration
$creadsPrec :: Int -> ReadS LustreFileSystemConfiguration
Prelude.Read, Int -> LustreFileSystemConfiguration -> ShowS
[LustreFileSystemConfiguration] -> ShowS
LustreFileSystemConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LustreFileSystemConfiguration] -> ShowS
$cshowList :: [LustreFileSystemConfiguration] -> ShowS
show :: LustreFileSystemConfiguration -> String
$cshow :: LustreFileSystemConfiguration -> String
showsPrec :: Int -> LustreFileSystemConfiguration -> ShowS
$cshowsPrec :: Int -> LustreFileSystemConfiguration -> ShowS
Prelude.Show, forall x.
Rep LustreFileSystemConfiguration x
-> LustreFileSystemConfiguration
forall x.
LustreFileSystemConfiguration
-> Rep LustreFileSystemConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep LustreFileSystemConfiguration x
-> LustreFileSystemConfiguration
$cfrom :: forall x.
LustreFileSystemConfiguration
-> Rep LustreFileSystemConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'LustreFileSystemConfiguration' 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:
--
-- 'automaticBackupRetentionDays', 'lustreFileSystemConfiguration_automaticBackupRetentionDays' - Undocumented member.
--
-- 'copyTagsToBackups', 'lustreFileSystemConfiguration_copyTagsToBackups' - A boolean flag indicating whether tags on the file system are copied to
-- backups. If it\'s set to true, all tags on the file system are copied to
-- all automatic backups and any user-initiated backups where the user
-- doesn\'t specify any tags. If this value is true, and you specify one or
-- more tags, only the specified tags are copied to backups. If you specify
-- one or more tags when creating a user-initiated backup, no tags are
-- copied from the file system, regardless of this value. (Default = false)
--
-- 'dailyAutomaticBackupStartTime', 'lustreFileSystemConfiguration_dailyAutomaticBackupStartTime' - Undocumented member.
--
-- 'dataCompressionType', 'lustreFileSystemConfiguration_dataCompressionType' - The data compression configuration for the file system.
-- @DataCompressionType@ can have the following values:
--
-- -   @NONE@ - Data compression is turned off for the file system.
--
-- -   @LZ4@ - Data compression is turned on with the LZ4 algorithm.
--
-- For more information, see
-- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/data-compression.html Lustre data compression>.
--
-- 'dataRepositoryConfiguration', 'lustreFileSystemConfiguration_dataRepositoryConfiguration' - Undocumented member.
--
-- 'deploymentType', 'lustreFileSystemConfiguration_deploymentType' - The deployment type of the FSx for Lustre file system. /Scratch
-- deployment type/ is designed for temporary storage and shorter-term
-- processing of data.
--
-- @SCRATCH_1@ and @SCRATCH_2@ deployment types are best suited for when
-- you need temporary storage and shorter-term processing of data. The
-- @SCRATCH_2@ deployment type provides in-transit encryption of data and
-- higher burst throughput capacity than @SCRATCH_1@.
--
-- The @PERSISTENT_1@ and @PERSISTENT_2@ deployment type is used for
-- longer-term storage and workloads and encryption of data in transit.
-- @PERSISTENT_2@ is built on Lustre v2.12 and offers higher
-- @PerUnitStorageThroughput@ (up to 1000 MB\/s\/TiB) along with a lower
-- minimum storage capacity requirement (600 GiB). To learn more about FSx
-- for Lustre deployment types, see
-- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/lustre-deployment-types.html FSx for Lustre deployment options>.
--
-- The default is @SCRATCH_1@.
--
-- 'driveCacheType', 'lustreFileSystemConfiguration_driveCacheType' - The type of drive cache used by @PERSISTENT_1@ file systems that are
-- provisioned with HDD storage devices. This parameter is required when
-- @StorageType@ is HDD. When set to @READ@ the file system has an SSD
-- storage cache that is sized to 20% of the file system\'s storage
-- capacity. This improves the performance for frequently accessed files by
-- caching up to 20% of the total storage capacity.
--
-- This parameter is required when @StorageType@ is set to HDD.
--
-- 'logConfiguration', 'lustreFileSystemConfiguration_logConfiguration' - The Lustre logging configuration. Lustre logging writes the enabled log
-- events for your file system to Amazon CloudWatch Logs.
--
-- 'mountName', 'lustreFileSystemConfiguration_mountName' - You use the @MountName@ value when mounting the file system.
--
-- For the @SCRATCH_1@ deployment type, this value is always \"@fsx@\". For
-- @SCRATCH_2@, @PERSISTENT_1@, and @PERSISTENT_2@ deployment types, this
-- value is a string that is unique within an Amazon Web Services Region.
--
-- 'perUnitStorageThroughput', 'lustreFileSystemConfiguration_perUnitStorageThroughput' - Per unit storage throughput represents the megabytes per second of read
-- or write throughput per 1 tebibyte of storage provisioned. File system
-- throughput capacity is equal to Storage capacity (TiB) *
-- PerUnitStorageThroughput (MB\/s\/TiB). This option is only valid for
-- @PERSISTENT_1@ and @PERSISTENT_2@ deployment types.
--
-- Valid values:
--
-- -   For @PERSISTENT_1@ SSD storage: 50, 100, 200.
--
-- -   For @PERSISTENT_1@ HDD storage: 12, 40.
--
-- -   For @PERSISTENT_2@ SSD storage: 125, 250, 500, 1000.
--
-- 'rootSquashConfiguration', 'lustreFileSystemConfiguration_rootSquashConfiguration' - The Lustre root squash configuration for an Amazon FSx for Lustre file
-- system. When enabled, root squash restricts root-level access from
-- clients that try to access your file system as a root user.
--
-- 'weeklyMaintenanceStartTime', 'lustreFileSystemConfiguration_weeklyMaintenanceStartTime' - The preferred start time to perform weekly maintenance, formatted
-- d:HH:MM in the UTC time zone. Here, @d@ is the weekday number, from 1
-- through 7, beginning with Monday and ending with Sunday.
newLustreFileSystemConfiguration ::
  LustreFileSystemConfiguration
newLustreFileSystemConfiguration :: LustreFileSystemConfiguration
newLustreFileSystemConfiguration =
  LustreFileSystemConfiguration'
    { $sel:automaticBackupRetentionDays:LustreFileSystemConfiguration' :: Maybe Natural
automaticBackupRetentionDays =
        forall a. Maybe a
Prelude.Nothing,
      $sel:copyTagsToBackups:LustreFileSystemConfiguration' :: Maybe Bool
copyTagsToBackups = forall a. Maybe a
Prelude.Nothing,
      $sel:dailyAutomaticBackupStartTime:LustreFileSystemConfiguration' :: Maybe Text
dailyAutomaticBackupStartTime =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dataCompressionType:LustreFileSystemConfiguration' :: Maybe DataCompressionType
dataCompressionType = forall a. Maybe a
Prelude.Nothing,
      $sel:dataRepositoryConfiguration:LustreFileSystemConfiguration' :: Maybe DataRepositoryConfiguration
dataRepositoryConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:deploymentType:LustreFileSystemConfiguration' :: Maybe LustreDeploymentType
deploymentType = forall a. Maybe a
Prelude.Nothing,
      $sel:driveCacheType:LustreFileSystemConfiguration' :: Maybe DriveCacheType
driveCacheType = forall a. Maybe a
Prelude.Nothing,
      $sel:logConfiguration:LustreFileSystemConfiguration' :: Maybe LustreLogConfiguration
logConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:mountName:LustreFileSystemConfiguration' :: Maybe Text
mountName = forall a. Maybe a
Prelude.Nothing,
      $sel:perUnitStorageThroughput:LustreFileSystemConfiguration' :: Maybe Natural
perUnitStorageThroughput = forall a. Maybe a
Prelude.Nothing,
      $sel:rootSquashConfiguration:LustreFileSystemConfiguration' :: Maybe LustreRootSquashConfiguration
rootSquashConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:weeklyMaintenanceStartTime:LustreFileSystemConfiguration' :: Maybe Text
weeklyMaintenanceStartTime = forall a. Maybe a
Prelude.Nothing
    }

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

-- | A boolean flag indicating whether tags on the file system are copied to
-- backups. If it\'s set to true, all tags on the file system are copied to
-- all automatic backups and any user-initiated backups where the user
-- doesn\'t specify any tags. If this value is true, and you specify one or
-- more tags, only the specified tags are copied to backups. If you specify
-- one or more tags when creating a user-initiated backup, no tags are
-- copied from the file system, regardless of this value. (Default = false)
lustreFileSystemConfiguration_copyTagsToBackups :: Lens.Lens' LustreFileSystemConfiguration (Prelude.Maybe Prelude.Bool)
lustreFileSystemConfiguration_copyTagsToBackups :: Lens' LustreFileSystemConfiguration (Maybe Bool)
lustreFileSystemConfiguration_copyTagsToBackups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LustreFileSystemConfiguration' {Maybe Bool
copyTagsToBackups :: Maybe Bool
$sel:copyTagsToBackups:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Bool
copyTagsToBackups} -> Maybe Bool
copyTagsToBackups) (\s :: LustreFileSystemConfiguration
s@LustreFileSystemConfiguration' {} Maybe Bool
a -> LustreFileSystemConfiguration
s {$sel:copyTagsToBackups:LustreFileSystemConfiguration' :: Maybe Bool
copyTagsToBackups = Maybe Bool
a} :: LustreFileSystemConfiguration)

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

-- | The data compression configuration for the file system.
-- @DataCompressionType@ can have the following values:
--
-- -   @NONE@ - Data compression is turned off for the file system.
--
-- -   @LZ4@ - Data compression is turned on with the LZ4 algorithm.
--
-- For more information, see
-- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/data-compression.html Lustre data compression>.
lustreFileSystemConfiguration_dataCompressionType :: Lens.Lens' LustreFileSystemConfiguration (Prelude.Maybe DataCompressionType)
lustreFileSystemConfiguration_dataCompressionType :: Lens' LustreFileSystemConfiguration (Maybe DataCompressionType)
lustreFileSystemConfiguration_dataCompressionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LustreFileSystemConfiguration' {Maybe DataCompressionType
dataCompressionType :: Maybe DataCompressionType
$sel:dataCompressionType:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe DataCompressionType
dataCompressionType} -> Maybe DataCompressionType
dataCompressionType) (\s :: LustreFileSystemConfiguration
s@LustreFileSystemConfiguration' {} Maybe DataCompressionType
a -> LustreFileSystemConfiguration
s {$sel:dataCompressionType:LustreFileSystemConfiguration' :: Maybe DataCompressionType
dataCompressionType = Maybe DataCompressionType
a} :: LustreFileSystemConfiguration)

-- | Undocumented member.
lustreFileSystemConfiguration_dataRepositoryConfiguration :: Lens.Lens' LustreFileSystemConfiguration (Prelude.Maybe DataRepositoryConfiguration)
lustreFileSystemConfiguration_dataRepositoryConfiguration :: Lens'
  LustreFileSystemConfiguration (Maybe DataRepositoryConfiguration)
lustreFileSystemConfiguration_dataRepositoryConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LustreFileSystemConfiguration' {Maybe DataRepositoryConfiguration
dataRepositoryConfiguration :: Maybe DataRepositoryConfiguration
$sel:dataRepositoryConfiguration:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe DataRepositoryConfiguration
dataRepositoryConfiguration} -> Maybe DataRepositoryConfiguration
dataRepositoryConfiguration) (\s :: LustreFileSystemConfiguration
s@LustreFileSystemConfiguration' {} Maybe DataRepositoryConfiguration
a -> LustreFileSystemConfiguration
s {$sel:dataRepositoryConfiguration:LustreFileSystemConfiguration' :: Maybe DataRepositoryConfiguration
dataRepositoryConfiguration = Maybe DataRepositoryConfiguration
a} :: LustreFileSystemConfiguration)

-- | The deployment type of the FSx for Lustre file system. /Scratch
-- deployment type/ is designed for temporary storage and shorter-term
-- processing of data.
--
-- @SCRATCH_1@ and @SCRATCH_2@ deployment types are best suited for when
-- you need temporary storage and shorter-term processing of data. The
-- @SCRATCH_2@ deployment type provides in-transit encryption of data and
-- higher burst throughput capacity than @SCRATCH_1@.
--
-- The @PERSISTENT_1@ and @PERSISTENT_2@ deployment type is used for
-- longer-term storage and workloads and encryption of data in transit.
-- @PERSISTENT_2@ is built on Lustre v2.12 and offers higher
-- @PerUnitStorageThroughput@ (up to 1000 MB\/s\/TiB) along with a lower
-- minimum storage capacity requirement (600 GiB). To learn more about FSx
-- for Lustre deployment types, see
-- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/lustre-deployment-types.html FSx for Lustre deployment options>.
--
-- The default is @SCRATCH_1@.
lustreFileSystemConfiguration_deploymentType :: Lens.Lens' LustreFileSystemConfiguration (Prelude.Maybe LustreDeploymentType)
lustreFileSystemConfiguration_deploymentType :: Lens' LustreFileSystemConfiguration (Maybe LustreDeploymentType)
lustreFileSystemConfiguration_deploymentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LustreFileSystemConfiguration' {Maybe LustreDeploymentType
deploymentType :: Maybe LustreDeploymentType
$sel:deploymentType:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe LustreDeploymentType
deploymentType} -> Maybe LustreDeploymentType
deploymentType) (\s :: LustreFileSystemConfiguration
s@LustreFileSystemConfiguration' {} Maybe LustreDeploymentType
a -> LustreFileSystemConfiguration
s {$sel:deploymentType:LustreFileSystemConfiguration' :: Maybe LustreDeploymentType
deploymentType = Maybe LustreDeploymentType
a} :: LustreFileSystemConfiguration)

-- | The type of drive cache used by @PERSISTENT_1@ file systems that are
-- provisioned with HDD storage devices. This parameter is required when
-- @StorageType@ is HDD. When set to @READ@ the file system has an SSD
-- storage cache that is sized to 20% of the file system\'s storage
-- capacity. This improves the performance for frequently accessed files by
-- caching up to 20% of the total storage capacity.
--
-- This parameter is required when @StorageType@ is set to HDD.
lustreFileSystemConfiguration_driveCacheType :: Lens.Lens' LustreFileSystemConfiguration (Prelude.Maybe DriveCacheType)
lustreFileSystemConfiguration_driveCacheType :: Lens' LustreFileSystemConfiguration (Maybe DriveCacheType)
lustreFileSystemConfiguration_driveCacheType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LustreFileSystemConfiguration' {Maybe DriveCacheType
driveCacheType :: Maybe DriveCacheType
$sel:driveCacheType:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe DriveCacheType
driveCacheType} -> Maybe DriveCacheType
driveCacheType) (\s :: LustreFileSystemConfiguration
s@LustreFileSystemConfiguration' {} Maybe DriveCacheType
a -> LustreFileSystemConfiguration
s {$sel:driveCacheType:LustreFileSystemConfiguration' :: Maybe DriveCacheType
driveCacheType = Maybe DriveCacheType
a} :: LustreFileSystemConfiguration)

-- | The Lustre logging configuration. Lustre logging writes the enabled log
-- events for your file system to Amazon CloudWatch Logs.
lustreFileSystemConfiguration_logConfiguration :: Lens.Lens' LustreFileSystemConfiguration (Prelude.Maybe LustreLogConfiguration)
lustreFileSystemConfiguration_logConfiguration :: Lens' LustreFileSystemConfiguration (Maybe LustreLogConfiguration)
lustreFileSystemConfiguration_logConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LustreFileSystemConfiguration' {Maybe LustreLogConfiguration
logConfiguration :: Maybe LustreLogConfiguration
$sel:logConfiguration:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe LustreLogConfiguration
logConfiguration} -> Maybe LustreLogConfiguration
logConfiguration) (\s :: LustreFileSystemConfiguration
s@LustreFileSystemConfiguration' {} Maybe LustreLogConfiguration
a -> LustreFileSystemConfiguration
s {$sel:logConfiguration:LustreFileSystemConfiguration' :: Maybe LustreLogConfiguration
logConfiguration = Maybe LustreLogConfiguration
a} :: LustreFileSystemConfiguration)

-- | You use the @MountName@ value when mounting the file system.
--
-- For the @SCRATCH_1@ deployment type, this value is always \"@fsx@\". For
-- @SCRATCH_2@, @PERSISTENT_1@, and @PERSISTENT_2@ deployment types, this
-- value is a string that is unique within an Amazon Web Services Region.
lustreFileSystemConfiguration_mountName :: Lens.Lens' LustreFileSystemConfiguration (Prelude.Maybe Prelude.Text)
lustreFileSystemConfiguration_mountName :: Lens' LustreFileSystemConfiguration (Maybe Text)
lustreFileSystemConfiguration_mountName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LustreFileSystemConfiguration' {Maybe Text
mountName :: Maybe Text
$sel:mountName:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Text
mountName} -> Maybe Text
mountName) (\s :: LustreFileSystemConfiguration
s@LustreFileSystemConfiguration' {} Maybe Text
a -> LustreFileSystemConfiguration
s {$sel:mountName:LustreFileSystemConfiguration' :: Maybe Text
mountName = Maybe Text
a} :: LustreFileSystemConfiguration)

-- | Per unit storage throughput represents the megabytes per second of read
-- or write throughput per 1 tebibyte of storage provisioned. File system
-- throughput capacity is equal to Storage capacity (TiB) *
-- PerUnitStorageThroughput (MB\/s\/TiB). This option is only valid for
-- @PERSISTENT_1@ and @PERSISTENT_2@ deployment types.
--
-- Valid values:
--
-- -   For @PERSISTENT_1@ SSD storage: 50, 100, 200.
--
-- -   For @PERSISTENT_1@ HDD storage: 12, 40.
--
-- -   For @PERSISTENT_2@ SSD storage: 125, 250, 500, 1000.
lustreFileSystemConfiguration_perUnitStorageThroughput :: Lens.Lens' LustreFileSystemConfiguration (Prelude.Maybe Prelude.Natural)
lustreFileSystemConfiguration_perUnitStorageThroughput :: Lens' LustreFileSystemConfiguration (Maybe Natural)
lustreFileSystemConfiguration_perUnitStorageThroughput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LustreFileSystemConfiguration' {Maybe Natural
perUnitStorageThroughput :: Maybe Natural
$sel:perUnitStorageThroughput:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Natural
perUnitStorageThroughput} -> Maybe Natural
perUnitStorageThroughput) (\s :: LustreFileSystemConfiguration
s@LustreFileSystemConfiguration' {} Maybe Natural
a -> LustreFileSystemConfiguration
s {$sel:perUnitStorageThroughput:LustreFileSystemConfiguration' :: Maybe Natural
perUnitStorageThroughput = Maybe Natural
a} :: LustreFileSystemConfiguration)

-- | The Lustre root squash configuration for an Amazon FSx for Lustre file
-- system. When enabled, root squash restricts root-level access from
-- clients that try to access your file system as a root user.
lustreFileSystemConfiguration_rootSquashConfiguration :: Lens.Lens' LustreFileSystemConfiguration (Prelude.Maybe LustreRootSquashConfiguration)
lustreFileSystemConfiguration_rootSquashConfiguration :: Lens'
  LustreFileSystemConfiguration (Maybe LustreRootSquashConfiguration)
lustreFileSystemConfiguration_rootSquashConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LustreFileSystemConfiguration' {Maybe LustreRootSquashConfiguration
rootSquashConfiguration :: Maybe LustreRootSquashConfiguration
$sel:rootSquashConfiguration:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration
-> Maybe LustreRootSquashConfiguration
rootSquashConfiguration} -> Maybe LustreRootSquashConfiguration
rootSquashConfiguration) (\s :: LustreFileSystemConfiguration
s@LustreFileSystemConfiguration' {} Maybe LustreRootSquashConfiguration
a -> LustreFileSystemConfiguration
s {$sel:rootSquashConfiguration:LustreFileSystemConfiguration' :: Maybe LustreRootSquashConfiguration
rootSquashConfiguration = Maybe LustreRootSquashConfiguration
a} :: LustreFileSystemConfiguration)

-- | The preferred start time to perform weekly maintenance, formatted
-- d:HH:MM in the UTC time zone. Here, @d@ is the weekday number, from 1
-- through 7, beginning with Monday and ending with Sunday.
lustreFileSystemConfiguration_weeklyMaintenanceStartTime :: Lens.Lens' LustreFileSystemConfiguration (Prelude.Maybe Prelude.Text)
lustreFileSystemConfiguration_weeklyMaintenanceStartTime :: Lens' LustreFileSystemConfiguration (Maybe Text)
lustreFileSystemConfiguration_weeklyMaintenanceStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LustreFileSystemConfiguration' {Maybe Text
weeklyMaintenanceStartTime :: Maybe Text
$sel:weeklyMaintenanceStartTime:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Text
weeklyMaintenanceStartTime} -> Maybe Text
weeklyMaintenanceStartTime) (\s :: LustreFileSystemConfiguration
s@LustreFileSystemConfiguration' {} Maybe Text
a -> LustreFileSystemConfiguration
s {$sel:weeklyMaintenanceStartTime:LustreFileSystemConfiguration' :: Maybe Text
weeklyMaintenanceStartTime = Maybe Text
a} :: LustreFileSystemConfiguration)

instance Data.FromJSON LustreFileSystemConfiguration where
  parseJSON :: Value -> Parser LustreFileSystemConfiguration
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"LustreFileSystemConfiguration"
      ( \Object
x ->
          Maybe Natural
-> Maybe Bool
-> Maybe Text
-> Maybe DataCompressionType
-> Maybe DataRepositoryConfiguration
-> Maybe LustreDeploymentType
-> Maybe DriveCacheType
-> Maybe LustreLogConfiguration
-> Maybe Text
-> Maybe Natural
-> Maybe LustreRootSquashConfiguration
-> Maybe Text
-> LustreFileSystemConfiguration
LustreFileSystemConfiguration'
            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
"AutomaticBackupRetentionDays")
            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
"CopyTagsToBackups")
            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
"DailyAutomaticBackupStartTime")
            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
"DataCompressionType")
            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
"DataRepositoryConfiguration")
            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
"DeploymentType")
            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
"DriveCacheType")
            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
"LogConfiguration")
            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
"MountName")
            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
"PerUnitStorageThroughput")
            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
"RootSquashConfiguration")
            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
"WeeklyMaintenanceStartTime")
      )

instance
  Prelude.Hashable
    LustreFileSystemConfiguration
  where
  hashWithSalt :: Int -> LustreFileSystemConfiguration -> Int
hashWithSalt Int
_salt LustreFileSystemConfiguration' {Maybe Bool
Maybe Natural
Maybe Text
Maybe DataCompressionType
Maybe DataRepositoryConfiguration
Maybe DriveCacheType
Maybe LustreDeploymentType
Maybe LustreLogConfiguration
Maybe LustreRootSquashConfiguration
weeklyMaintenanceStartTime :: Maybe Text
rootSquashConfiguration :: Maybe LustreRootSquashConfiguration
perUnitStorageThroughput :: Maybe Natural
mountName :: Maybe Text
logConfiguration :: Maybe LustreLogConfiguration
driveCacheType :: Maybe DriveCacheType
deploymentType :: Maybe LustreDeploymentType
dataRepositoryConfiguration :: Maybe DataRepositoryConfiguration
dataCompressionType :: Maybe DataCompressionType
dailyAutomaticBackupStartTime :: Maybe Text
copyTagsToBackups :: Maybe Bool
automaticBackupRetentionDays :: Maybe Natural
$sel:weeklyMaintenanceStartTime:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Text
$sel:rootSquashConfiguration:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration
-> Maybe LustreRootSquashConfiguration
$sel:perUnitStorageThroughput:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Natural
$sel:mountName:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Text
$sel:logConfiguration:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe LustreLogConfiguration
$sel:driveCacheType:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe DriveCacheType
$sel:deploymentType:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe LustreDeploymentType
$sel:dataRepositoryConfiguration:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe DataRepositoryConfiguration
$sel:dataCompressionType:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe DataCompressionType
$sel:dailyAutomaticBackupStartTime:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Text
$sel:copyTagsToBackups:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Bool
$sel:automaticBackupRetentionDays:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
automaticBackupRetentionDays
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
copyTagsToBackups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dailyAutomaticBackupStartTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataCompressionType
dataCompressionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataRepositoryConfiguration
dataRepositoryConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LustreDeploymentType
deploymentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DriveCacheType
driveCacheType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LustreLogConfiguration
logConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
mountName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
perUnitStorageThroughput
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LustreRootSquashConfiguration
rootSquashConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
weeklyMaintenanceStartTime

instance Prelude.NFData LustreFileSystemConfiguration where
  rnf :: LustreFileSystemConfiguration -> ()
rnf LustreFileSystemConfiguration' {Maybe Bool
Maybe Natural
Maybe Text
Maybe DataCompressionType
Maybe DataRepositoryConfiguration
Maybe DriveCacheType
Maybe LustreDeploymentType
Maybe LustreLogConfiguration
Maybe LustreRootSquashConfiguration
weeklyMaintenanceStartTime :: Maybe Text
rootSquashConfiguration :: Maybe LustreRootSquashConfiguration
perUnitStorageThroughput :: Maybe Natural
mountName :: Maybe Text
logConfiguration :: Maybe LustreLogConfiguration
driveCacheType :: Maybe DriveCacheType
deploymentType :: Maybe LustreDeploymentType
dataRepositoryConfiguration :: Maybe DataRepositoryConfiguration
dataCompressionType :: Maybe DataCompressionType
dailyAutomaticBackupStartTime :: Maybe Text
copyTagsToBackups :: Maybe Bool
automaticBackupRetentionDays :: Maybe Natural
$sel:weeklyMaintenanceStartTime:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Text
$sel:rootSquashConfiguration:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration
-> Maybe LustreRootSquashConfiguration
$sel:perUnitStorageThroughput:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Natural
$sel:mountName:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Text
$sel:logConfiguration:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe LustreLogConfiguration
$sel:driveCacheType:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe DriveCacheType
$sel:deploymentType:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe LustreDeploymentType
$sel:dataRepositoryConfiguration:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe DataRepositoryConfiguration
$sel:dataCompressionType:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe DataCompressionType
$sel:dailyAutomaticBackupStartTime:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Text
$sel:copyTagsToBackups:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Bool
$sel:automaticBackupRetentionDays:LustreFileSystemConfiguration' :: LustreFileSystemConfiguration -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
automaticBackupRetentionDays
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
copyTagsToBackups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dailyAutomaticBackupStartTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DataCompressionType
dataCompressionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DataRepositoryConfiguration
dataRepositoryConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LustreDeploymentType
deploymentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DriveCacheType
driveCacheType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LustreLogConfiguration
logConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
mountName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
perUnitStorageThroughput
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LustreRootSquashConfiguration
rootSquashConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
weeklyMaintenanceStartTime