{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.CreateFileSystem
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new, empty Amazon FSx file system. You can create the
-- following supported Amazon FSx file systems using the @CreateFileSystem@
-- API operation:
--
-- -   Amazon FSx for Lustre
--
-- -   Amazon FSx for NetApp ONTAP
--
-- -   Amazon FSx for OpenZFS
--
-- -   Amazon FSx for Windows File Server
--
-- This operation requires a client request token in the request that
-- Amazon FSx uses to ensure idempotent creation. This means that calling
-- the operation multiple times with the same client request token has no
-- effect. By using the idempotent operation, you can retry a
-- @CreateFileSystem@ operation without the risk of creating an extra file
-- system. This approach can be useful when an initial call fails in a way
-- that makes it unclear whether a file system was created. Examples are if
-- a transport level timeout occurred, or your connection was reset. If you
-- use the same client request token and the initial call created a file
-- system, the client receives success as long as the parameters are the
-- same.
--
-- If a file system with the specified client request token exists and the
-- parameters match, @CreateFileSystem@ returns the description of the
-- existing file system. If a file system with the specified client request
-- token exists and the parameters don\'t match, this call returns
-- @IncompatibleParameterError@. If a file system with the specified client
-- request token doesn\'t exist, @CreateFileSystem@ does the following:
--
-- -   Creates a new, empty Amazon FSx file system with an assigned ID, and
--     an initial lifecycle state of @CREATING@.
--
-- -   Returns the description of the file system in JSON format.
--
-- The @CreateFileSystem@ call returns while the file system\'s lifecycle
-- state is still @CREATING@. You can check the file-system creation status
-- by calling the
-- <https://docs.aws.amazon.com/fsx/latest/APIReference/API_DescribeFileSystems.html DescribeFileSystems>
-- operation, which returns the file system state along with other
-- information.
module Amazonka.FSx.CreateFileSystem
  ( -- * Creating a Request
    CreateFileSystem (..),
    newCreateFileSystem,

    -- * Request Lenses
    createFileSystem_clientRequestToken,
    createFileSystem_fileSystemTypeVersion,
    createFileSystem_kmsKeyId,
    createFileSystem_lustreConfiguration,
    createFileSystem_ontapConfiguration,
    createFileSystem_openZFSConfiguration,
    createFileSystem_securityGroupIds,
    createFileSystem_storageType,
    createFileSystem_tags,
    createFileSystem_windowsConfiguration,
    createFileSystem_fileSystemType,
    createFileSystem_storageCapacity,
    createFileSystem_subnetIds,

    -- * Destructuring the Response
    CreateFileSystemResponse (..),
    newCreateFileSystemResponse,

    -- * Response Lenses
    createFileSystemResponse_fileSystem,
    createFileSystemResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | The request object used to create a new Amazon FSx file system.
--
-- /See:/ 'newCreateFileSystem' smart constructor.
data CreateFileSystem = CreateFileSystem'
  { -- | A string of up to 64 ASCII characters that Amazon FSx uses to ensure
    -- idempotent creation. This string is automatically filled on your behalf
    -- when you use the Command Line Interface (CLI) or an Amazon Web Services
    -- SDK.
    CreateFileSystem -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | (Optional) For FSx for Lustre file systems, sets the Lustre version for
    -- the file system that you\'re creating. Valid values are @2.10@ and
    -- @2.12@:
    --
    -- -   2.10 is supported by the Scratch and Persistent_1 Lustre deployment
    --     types.
    --
    -- -   2.12 is supported by all Lustre deployment types. @2.12@ is required
    --     when setting FSx for Lustre @DeploymentType@ to @PERSISTENT_2@.
    --
    -- Default value = @2.10@, except when @DeploymentType@ is set to
    -- @PERSISTENT_2@, then the default is @2.12@.
    --
    -- If you set @FileSystemTypeVersion@ to @2.10@ for a @PERSISTENT_2@ Lustre
    -- deployment type, the @CreateFileSystem@ operation fails.
    CreateFileSystem -> Maybe Text
fileSystemTypeVersion :: Prelude.Maybe Prelude.Text,
    CreateFileSystem -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    CreateFileSystem -> Maybe CreateFileSystemLustreConfiguration
lustreConfiguration :: Prelude.Maybe CreateFileSystemLustreConfiguration,
    CreateFileSystem -> Maybe CreateFileSystemOntapConfiguration
ontapConfiguration :: Prelude.Maybe CreateFileSystemOntapConfiguration,
    -- | The OpenZFS configuration for the file system that\'s being created.
    CreateFileSystem -> Maybe CreateFileSystemOpenZFSConfiguration
openZFSConfiguration :: Prelude.Maybe CreateFileSystemOpenZFSConfiguration,
    -- | A list of IDs specifying the security groups to apply to all network
    -- interfaces created for file system access. This list isn\'t returned in
    -- later requests to describe the file system.
    CreateFileSystem -> Maybe [Text]
securityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | Sets the storage type for the file system that you\'re creating. Valid
    -- values are @SSD@ and @HDD@.
    --
    -- -   Set to @SSD@ to use solid state drive storage. SSD is supported on
    --     all Windows, Lustre, ONTAP, and OpenZFS deployment types.
    --
    -- -   Set to @HDD@ to use hard disk drive storage. HDD is supported on
    --     @SINGLE_AZ_2@ and @MULTI_AZ_1@ Windows file system deployment types,
    --     and on @PERSISTENT_1@ Lustre file system deployment types.
    --
    -- Default value is @SSD@. For more information, see
    -- <https://docs.aws.amazon.com/fsx/latest/WindowsGuide/optimize-fsx-costs.html#storage-type-options Storage type options>
    -- in the /FSx for Windows File Server User Guide/ and
    -- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/what-is.html#storage-options Multiple storage options>
    -- in the /FSx for Lustre User Guide/.
    CreateFileSystem -> Maybe StorageType
storageType :: Prelude.Maybe StorageType,
    -- | The tags to apply to the file system that\'s being created. The key
    -- value of the @Name@ tag appears in the console as the file system name.
    CreateFileSystem -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The Microsoft Windows configuration for the file system that\'s being
    -- created.
    CreateFileSystem -> Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration :: Prelude.Maybe CreateFileSystemWindowsConfiguration,
    -- | The type of Amazon FSx file system to create. Valid values are
    -- @WINDOWS@, @LUSTRE@, @ONTAP@, and @OPENZFS@.
    CreateFileSystem -> FileSystemType
fileSystemType :: FileSystemType,
    -- | Sets the storage capacity of the file system that you\'re creating, in
    -- gibibytes (GiB).
    --
    -- __FSx for Lustre file systems__ - The amount of storage capacity that
    -- you can configure depends on the value that you set for @StorageType@
    -- and the Lustre @DeploymentType@, as follows:
    --
    -- -   For @SCRATCH_2@, @PERSISTENT_2@ and @PERSISTENT_1@ deployment types
    --     using SSD storage type, the valid values are 1200 GiB, 2400 GiB, and
    --     increments of 2400 GiB.
    --
    -- -   For @PERSISTENT_1@ HDD file systems, valid values are increments of
    --     6000 GiB for 12 MB\/s\/TiB file systems and increments of 1800 GiB
    --     for 40 MB\/s\/TiB file systems.
    --
    -- -   For @SCRATCH_1@ deployment type, valid values are 1200 GiB, 2400
    --     GiB, and increments of 3600 GiB.
    --
    -- __FSx for ONTAP file systems__ - The amount of storage capacity that you
    -- can configure is from 1024 GiB up to 196,608 GiB (192 TiB).
    --
    -- __FSx for OpenZFS file systems__ - The amount of storage capacity that
    -- you can configure is from 64 GiB up to 524,288 GiB (512 TiB).
    --
    -- __FSx for Windows File Server file systems__ - The amount of storage
    -- capacity that you can configure depends on the value that you set for
    -- @StorageType@ as follows:
    --
    -- -   For SSD storage, valid values are 32 GiB-65,536 GiB (64 TiB).
    --
    -- -   For HDD storage, valid values are 2000 GiB-65,536 GiB (64 TiB).
    CreateFileSystem -> Natural
storageCapacity :: Prelude.Natural,
    -- | Specifies the IDs of the subnets that the file system will be accessible
    -- from. For Windows and ONTAP @MULTI_AZ_1@ deployment types,provide
    -- exactly two subnet IDs, one for the preferred file server and one for
    -- the standby file server. You specify one of these subnets as the
    -- preferred subnet using the @WindowsConfiguration > PreferredSubnetID@ or
    -- @OntapConfiguration > PreferredSubnetID@ properties. For more
    -- information about Multi-AZ file system configuration, see
    -- <https://docs.aws.amazon.com/fsx/latest/WindowsGuide/high-availability-multiAZ.html Availability and durability: Single-AZ and Multi-AZ file systems>
    -- in the /Amazon FSx for Windows User Guide/ and
    -- <https://docs.aws.amazon.com/fsx/latest/ONTAPGuide/high-availability-multiAZ.html Availability and durability>
    -- in the /Amazon FSx for ONTAP User Guide/.
    --
    -- For Windows @SINGLE_AZ_1@ and @SINGLE_AZ_2@ and all Lustre deployment
    -- types, provide exactly one subnet ID. The file server is launched in
    -- that subnet\'s Availability Zone.
    CreateFileSystem -> [Text]
subnetIds :: [Prelude.Text]
  }
  deriving (CreateFileSystem -> CreateFileSystem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFileSystem -> CreateFileSystem -> Bool
$c/= :: CreateFileSystem -> CreateFileSystem -> Bool
== :: CreateFileSystem -> CreateFileSystem -> Bool
$c== :: CreateFileSystem -> CreateFileSystem -> Bool
Prelude.Eq, Int -> CreateFileSystem -> ShowS
[CreateFileSystem] -> ShowS
CreateFileSystem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFileSystem] -> ShowS
$cshowList :: [CreateFileSystem] -> ShowS
show :: CreateFileSystem -> String
$cshow :: CreateFileSystem -> String
showsPrec :: Int -> CreateFileSystem -> ShowS
$cshowsPrec :: Int -> CreateFileSystem -> ShowS
Prelude.Show, forall x. Rep CreateFileSystem x -> CreateFileSystem
forall x. CreateFileSystem -> Rep CreateFileSystem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFileSystem x -> CreateFileSystem
$cfrom :: forall x. CreateFileSystem -> Rep CreateFileSystem x
Prelude.Generic)

-- |
-- Create a value of 'CreateFileSystem' 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:
--
-- 'clientRequestToken', 'createFileSystem_clientRequestToken' - A string of up to 64 ASCII characters that Amazon FSx uses to ensure
-- idempotent creation. This string is automatically filled on your behalf
-- when you use the Command Line Interface (CLI) or an Amazon Web Services
-- SDK.
--
-- 'fileSystemTypeVersion', 'createFileSystem_fileSystemTypeVersion' - (Optional) For FSx for Lustre file systems, sets the Lustre version for
-- the file system that you\'re creating. Valid values are @2.10@ and
-- @2.12@:
--
-- -   2.10 is supported by the Scratch and Persistent_1 Lustre deployment
--     types.
--
-- -   2.12 is supported by all Lustre deployment types. @2.12@ is required
--     when setting FSx for Lustre @DeploymentType@ to @PERSISTENT_2@.
--
-- Default value = @2.10@, except when @DeploymentType@ is set to
-- @PERSISTENT_2@, then the default is @2.12@.
--
-- If you set @FileSystemTypeVersion@ to @2.10@ for a @PERSISTENT_2@ Lustre
-- deployment type, the @CreateFileSystem@ operation fails.
--
-- 'kmsKeyId', 'createFileSystem_kmsKeyId' - Undocumented member.
--
-- 'lustreConfiguration', 'createFileSystem_lustreConfiguration' - Undocumented member.
--
-- 'ontapConfiguration', 'createFileSystem_ontapConfiguration' - Undocumented member.
--
-- 'openZFSConfiguration', 'createFileSystem_openZFSConfiguration' - The OpenZFS configuration for the file system that\'s being created.
--
-- 'securityGroupIds', 'createFileSystem_securityGroupIds' - A list of IDs specifying the security groups to apply to all network
-- interfaces created for file system access. This list isn\'t returned in
-- later requests to describe the file system.
--
-- 'storageType', 'createFileSystem_storageType' - Sets the storage type for the file system that you\'re creating. Valid
-- values are @SSD@ and @HDD@.
--
-- -   Set to @SSD@ to use solid state drive storage. SSD is supported on
--     all Windows, Lustre, ONTAP, and OpenZFS deployment types.
--
-- -   Set to @HDD@ to use hard disk drive storage. HDD is supported on
--     @SINGLE_AZ_2@ and @MULTI_AZ_1@ Windows file system deployment types,
--     and on @PERSISTENT_1@ Lustre file system deployment types.
--
-- Default value is @SSD@. For more information, see
-- <https://docs.aws.amazon.com/fsx/latest/WindowsGuide/optimize-fsx-costs.html#storage-type-options Storage type options>
-- in the /FSx for Windows File Server User Guide/ and
-- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/what-is.html#storage-options Multiple storage options>
-- in the /FSx for Lustre User Guide/.
--
-- 'tags', 'createFileSystem_tags' - The tags to apply to the file system that\'s being created. The key
-- value of the @Name@ tag appears in the console as the file system name.
--
-- 'windowsConfiguration', 'createFileSystem_windowsConfiguration' - The Microsoft Windows configuration for the file system that\'s being
-- created.
--
-- 'fileSystemType', 'createFileSystem_fileSystemType' - The type of Amazon FSx file system to create. Valid values are
-- @WINDOWS@, @LUSTRE@, @ONTAP@, and @OPENZFS@.
--
-- 'storageCapacity', 'createFileSystem_storageCapacity' - Sets the storage capacity of the file system that you\'re creating, in
-- gibibytes (GiB).
--
-- __FSx for Lustre file systems__ - The amount of storage capacity that
-- you can configure depends on the value that you set for @StorageType@
-- and the Lustre @DeploymentType@, as follows:
--
-- -   For @SCRATCH_2@, @PERSISTENT_2@ and @PERSISTENT_1@ deployment types
--     using SSD storage type, the valid values are 1200 GiB, 2400 GiB, and
--     increments of 2400 GiB.
--
-- -   For @PERSISTENT_1@ HDD file systems, valid values are increments of
--     6000 GiB for 12 MB\/s\/TiB file systems and increments of 1800 GiB
--     for 40 MB\/s\/TiB file systems.
--
-- -   For @SCRATCH_1@ deployment type, valid values are 1200 GiB, 2400
--     GiB, and increments of 3600 GiB.
--
-- __FSx for ONTAP file systems__ - The amount of storage capacity that you
-- can configure is from 1024 GiB up to 196,608 GiB (192 TiB).
--
-- __FSx for OpenZFS file systems__ - The amount of storage capacity that
-- you can configure is from 64 GiB up to 524,288 GiB (512 TiB).
--
-- __FSx for Windows File Server file systems__ - The amount of storage
-- capacity that you can configure depends on the value that you set for
-- @StorageType@ as follows:
--
-- -   For SSD storage, valid values are 32 GiB-65,536 GiB (64 TiB).
--
-- -   For HDD storage, valid values are 2000 GiB-65,536 GiB (64 TiB).
--
-- 'subnetIds', 'createFileSystem_subnetIds' - Specifies the IDs of the subnets that the file system will be accessible
-- from. For Windows and ONTAP @MULTI_AZ_1@ deployment types,provide
-- exactly two subnet IDs, one for the preferred file server and one for
-- the standby file server. You specify one of these subnets as the
-- preferred subnet using the @WindowsConfiguration > PreferredSubnetID@ or
-- @OntapConfiguration > PreferredSubnetID@ properties. For more
-- information about Multi-AZ file system configuration, see
-- <https://docs.aws.amazon.com/fsx/latest/WindowsGuide/high-availability-multiAZ.html Availability and durability: Single-AZ and Multi-AZ file systems>
-- in the /Amazon FSx for Windows User Guide/ and
-- <https://docs.aws.amazon.com/fsx/latest/ONTAPGuide/high-availability-multiAZ.html Availability and durability>
-- in the /Amazon FSx for ONTAP User Guide/.
--
-- For Windows @SINGLE_AZ_1@ and @SINGLE_AZ_2@ and all Lustre deployment
-- types, provide exactly one subnet ID. The file server is launched in
-- that subnet\'s Availability Zone.
newCreateFileSystem ::
  -- | 'fileSystemType'
  FileSystemType ->
  -- | 'storageCapacity'
  Prelude.Natural ->
  CreateFileSystem
newCreateFileSystem :: FileSystemType -> Natural -> CreateFileSystem
newCreateFileSystem
  FileSystemType
pFileSystemType_
  Natural
pStorageCapacity_ =
    CreateFileSystem'
      { $sel:clientRequestToken:CreateFileSystem' :: Maybe Text
clientRequestToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:fileSystemTypeVersion:CreateFileSystem' :: Maybe Text
fileSystemTypeVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:CreateFileSystem' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:lustreConfiguration:CreateFileSystem' :: Maybe CreateFileSystemLustreConfiguration
lustreConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:ontapConfiguration:CreateFileSystem' :: Maybe CreateFileSystemOntapConfiguration
ontapConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:openZFSConfiguration:CreateFileSystem' :: Maybe CreateFileSystemOpenZFSConfiguration
openZFSConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:securityGroupIds:CreateFileSystem' :: Maybe [Text]
securityGroupIds = forall a. Maybe a
Prelude.Nothing,
        $sel:storageType:CreateFileSystem' :: Maybe StorageType
storageType = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateFileSystem' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:windowsConfiguration:CreateFileSystem' :: Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:fileSystemType:CreateFileSystem' :: FileSystemType
fileSystemType = FileSystemType
pFileSystemType_,
        $sel:storageCapacity:CreateFileSystem' :: Natural
storageCapacity = Natural
pStorageCapacity_,
        $sel:subnetIds:CreateFileSystem' :: [Text]
subnetIds = forall a. Monoid a => a
Prelude.mempty
      }

-- | A string of up to 64 ASCII characters that Amazon FSx uses to ensure
-- idempotent creation. This string is automatically filled on your behalf
-- when you use the Command Line Interface (CLI) or an Amazon Web Services
-- SDK.
createFileSystem_clientRequestToken :: Lens.Lens' CreateFileSystem (Prelude.Maybe Prelude.Text)
createFileSystem_clientRequestToken :: Lens' CreateFileSystem (Maybe Text)
createFileSystem_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystem' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreateFileSystem' :: CreateFileSystem -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreateFileSystem
s@CreateFileSystem' {} Maybe Text
a -> CreateFileSystem
s {$sel:clientRequestToken:CreateFileSystem' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreateFileSystem)

-- | (Optional) For FSx for Lustre file systems, sets the Lustre version for
-- the file system that you\'re creating. Valid values are @2.10@ and
-- @2.12@:
--
-- -   2.10 is supported by the Scratch and Persistent_1 Lustre deployment
--     types.
--
-- -   2.12 is supported by all Lustre deployment types. @2.12@ is required
--     when setting FSx for Lustre @DeploymentType@ to @PERSISTENT_2@.
--
-- Default value = @2.10@, except when @DeploymentType@ is set to
-- @PERSISTENT_2@, then the default is @2.12@.
--
-- If you set @FileSystemTypeVersion@ to @2.10@ for a @PERSISTENT_2@ Lustre
-- deployment type, the @CreateFileSystem@ operation fails.
createFileSystem_fileSystemTypeVersion :: Lens.Lens' CreateFileSystem (Prelude.Maybe Prelude.Text)
createFileSystem_fileSystemTypeVersion :: Lens' CreateFileSystem (Maybe Text)
createFileSystem_fileSystemTypeVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystem' {Maybe Text
fileSystemTypeVersion :: Maybe Text
$sel:fileSystemTypeVersion:CreateFileSystem' :: CreateFileSystem -> Maybe Text
fileSystemTypeVersion} -> Maybe Text
fileSystemTypeVersion) (\s :: CreateFileSystem
s@CreateFileSystem' {} Maybe Text
a -> CreateFileSystem
s {$sel:fileSystemTypeVersion:CreateFileSystem' :: Maybe Text
fileSystemTypeVersion = Maybe Text
a} :: CreateFileSystem)

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

-- | Undocumented member.
createFileSystem_lustreConfiguration :: Lens.Lens' CreateFileSystem (Prelude.Maybe CreateFileSystemLustreConfiguration)
createFileSystem_lustreConfiguration :: Lens' CreateFileSystem (Maybe CreateFileSystemLustreConfiguration)
createFileSystem_lustreConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystem' {Maybe CreateFileSystemLustreConfiguration
lustreConfiguration :: Maybe CreateFileSystemLustreConfiguration
$sel:lustreConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemLustreConfiguration
lustreConfiguration} -> Maybe CreateFileSystemLustreConfiguration
lustreConfiguration) (\s :: CreateFileSystem
s@CreateFileSystem' {} Maybe CreateFileSystemLustreConfiguration
a -> CreateFileSystem
s {$sel:lustreConfiguration:CreateFileSystem' :: Maybe CreateFileSystemLustreConfiguration
lustreConfiguration = Maybe CreateFileSystemLustreConfiguration
a} :: CreateFileSystem)

-- | Undocumented member.
createFileSystem_ontapConfiguration :: Lens.Lens' CreateFileSystem (Prelude.Maybe CreateFileSystemOntapConfiguration)
createFileSystem_ontapConfiguration :: Lens' CreateFileSystem (Maybe CreateFileSystemOntapConfiguration)
createFileSystem_ontapConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystem' {Maybe CreateFileSystemOntapConfiguration
ontapConfiguration :: Maybe CreateFileSystemOntapConfiguration
$sel:ontapConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemOntapConfiguration
ontapConfiguration} -> Maybe CreateFileSystemOntapConfiguration
ontapConfiguration) (\s :: CreateFileSystem
s@CreateFileSystem' {} Maybe CreateFileSystemOntapConfiguration
a -> CreateFileSystem
s {$sel:ontapConfiguration:CreateFileSystem' :: Maybe CreateFileSystemOntapConfiguration
ontapConfiguration = Maybe CreateFileSystemOntapConfiguration
a} :: CreateFileSystem)

-- | The OpenZFS configuration for the file system that\'s being created.
createFileSystem_openZFSConfiguration :: Lens.Lens' CreateFileSystem (Prelude.Maybe CreateFileSystemOpenZFSConfiguration)
createFileSystem_openZFSConfiguration :: Lens' CreateFileSystem (Maybe CreateFileSystemOpenZFSConfiguration)
createFileSystem_openZFSConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystem' {Maybe CreateFileSystemOpenZFSConfiguration
openZFSConfiguration :: Maybe CreateFileSystemOpenZFSConfiguration
$sel:openZFSConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemOpenZFSConfiguration
openZFSConfiguration} -> Maybe CreateFileSystemOpenZFSConfiguration
openZFSConfiguration) (\s :: CreateFileSystem
s@CreateFileSystem' {} Maybe CreateFileSystemOpenZFSConfiguration
a -> CreateFileSystem
s {$sel:openZFSConfiguration:CreateFileSystem' :: Maybe CreateFileSystemOpenZFSConfiguration
openZFSConfiguration = Maybe CreateFileSystemOpenZFSConfiguration
a} :: CreateFileSystem)

-- | A list of IDs specifying the security groups to apply to all network
-- interfaces created for file system access. This list isn\'t returned in
-- later requests to describe the file system.
createFileSystem_securityGroupIds :: Lens.Lens' CreateFileSystem (Prelude.Maybe [Prelude.Text])
createFileSystem_securityGroupIds :: Lens' CreateFileSystem (Maybe [Text])
createFileSystem_securityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystem' {Maybe [Text]
securityGroupIds :: Maybe [Text]
$sel:securityGroupIds:CreateFileSystem' :: CreateFileSystem -> Maybe [Text]
securityGroupIds} -> Maybe [Text]
securityGroupIds) (\s :: CreateFileSystem
s@CreateFileSystem' {} Maybe [Text]
a -> CreateFileSystem
s {$sel:securityGroupIds:CreateFileSystem' :: Maybe [Text]
securityGroupIds = Maybe [Text]
a} :: CreateFileSystem) 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

-- | Sets the storage type for the file system that you\'re creating. Valid
-- values are @SSD@ and @HDD@.
--
-- -   Set to @SSD@ to use solid state drive storage. SSD is supported on
--     all Windows, Lustre, ONTAP, and OpenZFS deployment types.
--
-- -   Set to @HDD@ to use hard disk drive storage. HDD is supported on
--     @SINGLE_AZ_2@ and @MULTI_AZ_1@ Windows file system deployment types,
--     and on @PERSISTENT_1@ Lustre file system deployment types.
--
-- Default value is @SSD@. For more information, see
-- <https://docs.aws.amazon.com/fsx/latest/WindowsGuide/optimize-fsx-costs.html#storage-type-options Storage type options>
-- in the /FSx for Windows File Server User Guide/ and
-- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/what-is.html#storage-options Multiple storage options>
-- in the /FSx for Lustre User Guide/.
createFileSystem_storageType :: Lens.Lens' CreateFileSystem (Prelude.Maybe StorageType)
createFileSystem_storageType :: Lens' CreateFileSystem (Maybe StorageType)
createFileSystem_storageType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystem' {Maybe StorageType
storageType :: Maybe StorageType
$sel:storageType:CreateFileSystem' :: CreateFileSystem -> Maybe StorageType
storageType} -> Maybe StorageType
storageType) (\s :: CreateFileSystem
s@CreateFileSystem' {} Maybe StorageType
a -> CreateFileSystem
s {$sel:storageType:CreateFileSystem' :: Maybe StorageType
storageType = Maybe StorageType
a} :: CreateFileSystem)

-- | The tags to apply to the file system that\'s being created. The key
-- value of the @Name@ tag appears in the console as the file system name.
createFileSystem_tags :: Lens.Lens' CreateFileSystem (Prelude.Maybe (Prelude.NonEmpty Tag))
createFileSystem_tags :: Lens' CreateFileSystem (Maybe (NonEmpty Tag))
createFileSystem_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystem' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateFileSystem' :: CreateFileSystem -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateFileSystem
s@CreateFileSystem' {} Maybe (NonEmpty Tag)
a -> CreateFileSystem
s {$sel:tags:CreateFileSystem' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateFileSystem) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Microsoft Windows configuration for the file system that\'s being
-- created.
createFileSystem_windowsConfiguration :: Lens.Lens' CreateFileSystem (Prelude.Maybe CreateFileSystemWindowsConfiguration)
createFileSystem_windowsConfiguration :: Lens' CreateFileSystem (Maybe CreateFileSystemWindowsConfiguration)
createFileSystem_windowsConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystem' {Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration :: Maybe CreateFileSystemWindowsConfiguration
$sel:windowsConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration} -> Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration) (\s :: CreateFileSystem
s@CreateFileSystem' {} Maybe CreateFileSystemWindowsConfiguration
a -> CreateFileSystem
s {$sel:windowsConfiguration:CreateFileSystem' :: Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration = Maybe CreateFileSystemWindowsConfiguration
a} :: CreateFileSystem)

-- | The type of Amazon FSx file system to create. Valid values are
-- @WINDOWS@, @LUSTRE@, @ONTAP@, and @OPENZFS@.
createFileSystem_fileSystemType :: Lens.Lens' CreateFileSystem FileSystemType
createFileSystem_fileSystemType :: Lens' CreateFileSystem FileSystemType
createFileSystem_fileSystemType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystem' {FileSystemType
fileSystemType :: FileSystemType
$sel:fileSystemType:CreateFileSystem' :: CreateFileSystem -> FileSystemType
fileSystemType} -> FileSystemType
fileSystemType) (\s :: CreateFileSystem
s@CreateFileSystem' {} FileSystemType
a -> CreateFileSystem
s {$sel:fileSystemType:CreateFileSystem' :: FileSystemType
fileSystemType = FileSystemType
a} :: CreateFileSystem)

-- | Sets the storage capacity of the file system that you\'re creating, in
-- gibibytes (GiB).
--
-- __FSx for Lustre file systems__ - The amount of storage capacity that
-- you can configure depends on the value that you set for @StorageType@
-- and the Lustre @DeploymentType@, as follows:
--
-- -   For @SCRATCH_2@, @PERSISTENT_2@ and @PERSISTENT_1@ deployment types
--     using SSD storage type, the valid values are 1200 GiB, 2400 GiB, and
--     increments of 2400 GiB.
--
-- -   For @PERSISTENT_1@ HDD file systems, valid values are increments of
--     6000 GiB for 12 MB\/s\/TiB file systems and increments of 1800 GiB
--     for 40 MB\/s\/TiB file systems.
--
-- -   For @SCRATCH_1@ deployment type, valid values are 1200 GiB, 2400
--     GiB, and increments of 3600 GiB.
--
-- __FSx for ONTAP file systems__ - The amount of storage capacity that you
-- can configure is from 1024 GiB up to 196,608 GiB (192 TiB).
--
-- __FSx for OpenZFS file systems__ - The amount of storage capacity that
-- you can configure is from 64 GiB up to 524,288 GiB (512 TiB).
--
-- __FSx for Windows File Server file systems__ - The amount of storage
-- capacity that you can configure depends on the value that you set for
-- @StorageType@ as follows:
--
-- -   For SSD storage, valid values are 32 GiB-65,536 GiB (64 TiB).
--
-- -   For HDD storage, valid values are 2000 GiB-65,536 GiB (64 TiB).
createFileSystem_storageCapacity :: Lens.Lens' CreateFileSystem Prelude.Natural
createFileSystem_storageCapacity :: Lens' CreateFileSystem Natural
createFileSystem_storageCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystem' {Natural
storageCapacity :: Natural
$sel:storageCapacity:CreateFileSystem' :: CreateFileSystem -> Natural
storageCapacity} -> Natural
storageCapacity) (\s :: CreateFileSystem
s@CreateFileSystem' {} Natural
a -> CreateFileSystem
s {$sel:storageCapacity:CreateFileSystem' :: Natural
storageCapacity = Natural
a} :: CreateFileSystem)

-- | Specifies the IDs of the subnets that the file system will be accessible
-- from. For Windows and ONTAP @MULTI_AZ_1@ deployment types,provide
-- exactly two subnet IDs, one for the preferred file server and one for
-- the standby file server. You specify one of these subnets as the
-- preferred subnet using the @WindowsConfiguration > PreferredSubnetID@ or
-- @OntapConfiguration > PreferredSubnetID@ properties. For more
-- information about Multi-AZ file system configuration, see
-- <https://docs.aws.amazon.com/fsx/latest/WindowsGuide/high-availability-multiAZ.html Availability and durability: Single-AZ and Multi-AZ file systems>
-- in the /Amazon FSx for Windows User Guide/ and
-- <https://docs.aws.amazon.com/fsx/latest/ONTAPGuide/high-availability-multiAZ.html Availability and durability>
-- in the /Amazon FSx for ONTAP User Guide/.
--
-- For Windows @SINGLE_AZ_1@ and @SINGLE_AZ_2@ and all Lustre deployment
-- types, provide exactly one subnet ID. The file server is launched in
-- that subnet\'s Availability Zone.
createFileSystem_subnetIds :: Lens.Lens' CreateFileSystem [Prelude.Text]
createFileSystem_subnetIds :: Lens' CreateFileSystem [Text]
createFileSystem_subnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystem' {[Text]
subnetIds :: [Text]
$sel:subnetIds:CreateFileSystem' :: CreateFileSystem -> [Text]
subnetIds} -> [Text]
subnetIds) (\s :: CreateFileSystem
s@CreateFileSystem' {} [Text]
a -> CreateFileSystem
s {$sel:subnetIds:CreateFileSystem' :: [Text]
subnetIds = [Text]
a} :: CreateFileSystem) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateFileSystem where
  type
    AWSResponse CreateFileSystem =
      CreateFileSystemResponse
  request :: (Service -> Service)
-> CreateFileSystem -> Request CreateFileSystem
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateFileSystem
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateFileSystem)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe FileSystem -> Int -> CreateFileSystemResponse
CreateFileSystemResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"FileSystem")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateFileSystem where
  hashWithSalt :: Int -> CreateFileSystem -> Int
hashWithSalt Int
_salt CreateFileSystem' {Natural
[Text]
Maybe [Text]
Maybe (NonEmpty Tag)
Maybe Text
Maybe CreateFileSystemLustreConfiguration
Maybe CreateFileSystemOntapConfiguration
Maybe CreateFileSystemOpenZFSConfiguration
Maybe StorageType
Maybe CreateFileSystemWindowsConfiguration
FileSystemType
subnetIds :: [Text]
storageCapacity :: Natural
fileSystemType :: FileSystemType
windowsConfiguration :: Maybe CreateFileSystemWindowsConfiguration
tags :: Maybe (NonEmpty Tag)
storageType :: Maybe StorageType
securityGroupIds :: Maybe [Text]
openZFSConfiguration :: Maybe CreateFileSystemOpenZFSConfiguration
ontapConfiguration :: Maybe CreateFileSystemOntapConfiguration
lustreConfiguration :: Maybe CreateFileSystemLustreConfiguration
kmsKeyId :: Maybe Text
fileSystemTypeVersion :: Maybe Text
clientRequestToken :: Maybe Text
$sel:subnetIds:CreateFileSystem' :: CreateFileSystem -> [Text]
$sel:storageCapacity:CreateFileSystem' :: CreateFileSystem -> Natural
$sel:fileSystemType:CreateFileSystem' :: CreateFileSystem -> FileSystemType
$sel:windowsConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemWindowsConfiguration
$sel:tags:CreateFileSystem' :: CreateFileSystem -> Maybe (NonEmpty Tag)
$sel:storageType:CreateFileSystem' :: CreateFileSystem -> Maybe StorageType
$sel:securityGroupIds:CreateFileSystem' :: CreateFileSystem -> Maybe [Text]
$sel:openZFSConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemOpenZFSConfiguration
$sel:ontapConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemOntapConfiguration
$sel:lustreConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemLustreConfiguration
$sel:kmsKeyId:CreateFileSystem' :: CreateFileSystem -> Maybe Text
$sel:fileSystemTypeVersion:CreateFileSystem' :: CreateFileSystem -> Maybe Text
$sel:clientRequestToken:CreateFileSystem' :: CreateFileSystem -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
fileSystemTypeVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CreateFileSystemLustreConfiguration
lustreConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CreateFileSystemOntapConfiguration
ontapConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CreateFileSystemOpenZFSConfiguration
openZFSConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StorageType
storageType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FileSystemType
fileSystemType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
storageCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
subnetIds

instance Prelude.NFData CreateFileSystem where
  rnf :: CreateFileSystem -> ()
rnf CreateFileSystem' {Natural
[Text]
Maybe [Text]
Maybe (NonEmpty Tag)
Maybe Text
Maybe CreateFileSystemLustreConfiguration
Maybe CreateFileSystemOntapConfiguration
Maybe CreateFileSystemOpenZFSConfiguration
Maybe StorageType
Maybe CreateFileSystemWindowsConfiguration
FileSystemType
subnetIds :: [Text]
storageCapacity :: Natural
fileSystemType :: FileSystemType
windowsConfiguration :: Maybe CreateFileSystemWindowsConfiguration
tags :: Maybe (NonEmpty Tag)
storageType :: Maybe StorageType
securityGroupIds :: Maybe [Text]
openZFSConfiguration :: Maybe CreateFileSystemOpenZFSConfiguration
ontapConfiguration :: Maybe CreateFileSystemOntapConfiguration
lustreConfiguration :: Maybe CreateFileSystemLustreConfiguration
kmsKeyId :: Maybe Text
fileSystemTypeVersion :: Maybe Text
clientRequestToken :: Maybe Text
$sel:subnetIds:CreateFileSystem' :: CreateFileSystem -> [Text]
$sel:storageCapacity:CreateFileSystem' :: CreateFileSystem -> Natural
$sel:fileSystemType:CreateFileSystem' :: CreateFileSystem -> FileSystemType
$sel:windowsConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemWindowsConfiguration
$sel:tags:CreateFileSystem' :: CreateFileSystem -> Maybe (NonEmpty Tag)
$sel:storageType:CreateFileSystem' :: CreateFileSystem -> Maybe StorageType
$sel:securityGroupIds:CreateFileSystem' :: CreateFileSystem -> Maybe [Text]
$sel:openZFSConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemOpenZFSConfiguration
$sel:ontapConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemOntapConfiguration
$sel:lustreConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemLustreConfiguration
$sel:kmsKeyId:CreateFileSystem' :: CreateFileSystem -> Maybe Text
$sel:fileSystemTypeVersion:CreateFileSystem' :: CreateFileSystem -> Maybe Text
$sel:clientRequestToken:CreateFileSystem' :: CreateFileSystem -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
fileSystemTypeVersion
      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 CreateFileSystemLustreConfiguration
lustreConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CreateFileSystemOntapConfiguration
ontapConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CreateFileSystemOpenZFSConfiguration
openZFSConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
securityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StorageType
storageType
      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 CreateFileSystemWindowsConfiguration
windowsConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FileSystemType
fileSystemType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
storageCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
subnetIds

instance Data.ToHeaders CreateFileSystem where
  toHeaders :: CreateFileSystem -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AWSSimbaAPIService_v20180301.CreateFileSystem" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateFileSystem where
  toJSON :: CreateFileSystem -> Value
toJSON CreateFileSystem' {Natural
[Text]
Maybe [Text]
Maybe (NonEmpty Tag)
Maybe Text
Maybe CreateFileSystemLustreConfiguration
Maybe CreateFileSystemOntapConfiguration
Maybe CreateFileSystemOpenZFSConfiguration
Maybe StorageType
Maybe CreateFileSystemWindowsConfiguration
FileSystemType
subnetIds :: [Text]
storageCapacity :: Natural
fileSystemType :: FileSystemType
windowsConfiguration :: Maybe CreateFileSystemWindowsConfiguration
tags :: Maybe (NonEmpty Tag)
storageType :: Maybe StorageType
securityGroupIds :: Maybe [Text]
openZFSConfiguration :: Maybe CreateFileSystemOpenZFSConfiguration
ontapConfiguration :: Maybe CreateFileSystemOntapConfiguration
lustreConfiguration :: Maybe CreateFileSystemLustreConfiguration
kmsKeyId :: Maybe Text
fileSystemTypeVersion :: Maybe Text
clientRequestToken :: Maybe Text
$sel:subnetIds:CreateFileSystem' :: CreateFileSystem -> [Text]
$sel:storageCapacity:CreateFileSystem' :: CreateFileSystem -> Natural
$sel:fileSystemType:CreateFileSystem' :: CreateFileSystem -> FileSystemType
$sel:windowsConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemWindowsConfiguration
$sel:tags:CreateFileSystem' :: CreateFileSystem -> Maybe (NonEmpty Tag)
$sel:storageType:CreateFileSystem' :: CreateFileSystem -> Maybe StorageType
$sel:securityGroupIds:CreateFileSystem' :: CreateFileSystem -> Maybe [Text]
$sel:openZFSConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemOpenZFSConfiguration
$sel:ontapConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemOntapConfiguration
$sel:lustreConfiguration:CreateFileSystem' :: CreateFileSystem -> Maybe CreateFileSystemLustreConfiguration
$sel:kmsKeyId:CreateFileSystem' :: CreateFileSystem -> Maybe Text
$sel:fileSystemTypeVersion:CreateFileSystem' :: CreateFileSystem -> Maybe Text
$sel:clientRequestToken:CreateFileSystem' :: CreateFileSystem -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientRequestToken,
            (Key
"FileSystemTypeVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
fileSystemTypeVersion,
            (Key
"KmsKeyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
kmsKeyId,
            (Key
"LustreConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CreateFileSystemLustreConfiguration
lustreConfiguration,
            (Key
"OntapConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CreateFileSystemOntapConfiguration
ontapConfiguration,
            (Key
"OpenZFSConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CreateFileSystemOpenZFSConfiguration
openZFSConfiguration,
            (Key
"SecurityGroupIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
securityGroupIds,
            (Key
"StorageType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe StorageType
storageType,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Tag)
tags,
            (Key
"WindowsConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"FileSystemType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= FileSystemType
fileSystemType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"StorageCapacity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
storageCapacity),
            forall a. a -> Maybe a
Prelude.Just (Key
"SubnetIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
subnetIds)
          ]
      )

instance Data.ToPath CreateFileSystem where
  toPath :: CreateFileSystem -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery CreateFileSystem where
  toQuery :: CreateFileSystem -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | The response object returned after the file system is created.
--
-- /See:/ 'newCreateFileSystemResponse' smart constructor.
data CreateFileSystemResponse = CreateFileSystemResponse'
  { -- | The configuration of the file system that was created.
    CreateFileSystemResponse -> Maybe FileSystem
fileSystem :: Prelude.Maybe FileSystem,
    -- | The response's http status code.
    CreateFileSystemResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateFileSystemResponse -> CreateFileSystemResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFileSystemResponse -> CreateFileSystemResponse -> Bool
$c/= :: CreateFileSystemResponse -> CreateFileSystemResponse -> Bool
== :: CreateFileSystemResponse -> CreateFileSystemResponse -> Bool
$c== :: CreateFileSystemResponse -> CreateFileSystemResponse -> Bool
Prelude.Eq, ReadPrec [CreateFileSystemResponse]
ReadPrec CreateFileSystemResponse
Int -> ReadS CreateFileSystemResponse
ReadS [CreateFileSystemResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFileSystemResponse]
$creadListPrec :: ReadPrec [CreateFileSystemResponse]
readPrec :: ReadPrec CreateFileSystemResponse
$creadPrec :: ReadPrec CreateFileSystemResponse
readList :: ReadS [CreateFileSystemResponse]
$creadList :: ReadS [CreateFileSystemResponse]
readsPrec :: Int -> ReadS CreateFileSystemResponse
$creadsPrec :: Int -> ReadS CreateFileSystemResponse
Prelude.Read, Int -> CreateFileSystemResponse -> ShowS
[CreateFileSystemResponse] -> ShowS
CreateFileSystemResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFileSystemResponse] -> ShowS
$cshowList :: [CreateFileSystemResponse] -> ShowS
show :: CreateFileSystemResponse -> String
$cshow :: CreateFileSystemResponse -> String
showsPrec :: Int -> CreateFileSystemResponse -> ShowS
$cshowsPrec :: Int -> CreateFileSystemResponse -> ShowS
Prelude.Show, forall x.
Rep CreateFileSystemResponse x -> CreateFileSystemResponse
forall x.
CreateFileSystemResponse -> Rep CreateFileSystemResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateFileSystemResponse x -> CreateFileSystemResponse
$cfrom :: forall x.
CreateFileSystemResponse -> Rep CreateFileSystemResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateFileSystemResponse' 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:
--
-- 'fileSystem', 'createFileSystemResponse_fileSystem' - The configuration of the file system that was created.
--
-- 'httpStatus', 'createFileSystemResponse_httpStatus' - The response's http status code.
newCreateFileSystemResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateFileSystemResponse
newCreateFileSystemResponse :: Int -> CreateFileSystemResponse
newCreateFileSystemResponse Int
pHttpStatus_ =
  CreateFileSystemResponse'
    { $sel:fileSystem:CreateFileSystemResponse' :: Maybe FileSystem
fileSystem =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateFileSystemResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The configuration of the file system that was created.
createFileSystemResponse_fileSystem :: Lens.Lens' CreateFileSystemResponse (Prelude.Maybe FileSystem)
createFileSystemResponse_fileSystem :: Lens' CreateFileSystemResponse (Maybe FileSystem)
createFileSystemResponse_fileSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystemResponse' {Maybe FileSystem
fileSystem :: Maybe FileSystem
$sel:fileSystem:CreateFileSystemResponse' :: CreateFileSystemResponse -> Maybe FileSystem
fileSystem} -> Maybe FileSystem
fileSystem) (\s :: CreateFileSystemResponse
s@CreateFileSystemResponse' {} Maybe FileSystem
a -> CreateFileSystemResponse
s {$sel:fileSystem:CreateFileSystemResponse' :: Maybe FileSystem
fileSystem = Maybe FileSystem
a} :: CreateFileSystemResponse)

-- | The response's http status code.
createFileSystemResponse_httpStatus :: Lens.Lens' CreateFileSystemResponse Prelude.Int
createFileSystemResponse_httpStatus :: Lens' CreateFileSystemResponse Int
createFileSystemResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystemResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateFileSystemResponse' :: CreateFileSystemResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateFileSystemResponse
s@CreateFileSystemResponse' {} Int
a -> CreateFileSystemResponse
s {$sel:httpStatus:CreateFileSystemResponse' :: Int
httpStatus = Int
a} :: CreateFileSystemResponse)

instance Prelude.NFData CreateFileSystemResponse where
  rnf :: CreateFileSystemResponse -> ()
rnf CreateFileSystemResponse' {Int
Maybe FileSystem
httpStatus :: Int
fileSystem :: Maybe FileSystem
$sel:httpStatus:CreateFileSystemResponse' :: CreateFileSystemResponse -> Int
$sel:fileSystem:CreateFileSystemResponse' :: CreateFileSystemResponse -> Maybe FileSystem
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FileSystem
fileSystem
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus