{-# 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.CreateFileSystemFromBackup
-- 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 Amazon FSx for Lustre, Amazon FSx for Windows File Server,
-- or Amazon FSx for OpenZFS file system from an existing Amazon FSx
-- backup.
--
-- If a file system with the specified client request token exists and the
-- parameters match, this operation returns the description of the file
-- system. If a file system with the specified client request token exists
-- but the parameters don\'t match, this call returns
-- @IncompatibleParameterError@. If a file system with the specified client
-- request token doesn\'t exist, this operation does the following:
--
-- -   Creates a new Amazon FSx file system from backup with an assigned
--     ID, and an initial lifecycle state of @CREATING@.
--
-- -   Returns the description of the file system.
--
-- Parameters like the Active Directory, default share name, automatic
-- backup, and backup settings default to the parameters of the file system
-- that was backed up, unless overridden. You can explicitly supply other
-- settings.
--
-- By using the idempotent operation, you can retry a
-- @CreateFileSystemFromBackup@ call 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 a success message as long as the
-- parameters are the same.
--
-- The @CreateFileSystemFromBackup@ 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.CreateFileSystemFromBackup
  ( -- * Creating a Request
    CreateFileSystemFromBackup (..),
    newCreateFileSystemFromBackup,

    -- * Request Lenses
    createFileSystemFromBackup_clientRequestToken,
    createFileSystemFromBackup_fileSystemTypeVersion,
    createFileSystemFromBackup_kmsKeyId,
    createFileSystemFromBackup_lustreConfiguration,
    createFileSystemFromBackup_openZFSConfiguration,
    createFileSystemFromBackup_securityGroupIds,
    createFileSystemFromBackup_storageCapacity,
    createFileSystemFromBackup_storageType,
    createFileSystemFromBackup_tags,
    createFileSystemFromBackup_windowsConfiguration,
    createFileSystemFromBackup_backupId,
    createFileSystemFromBackup_subnetIds,

    -- * Destructuring the Response
    CreateFileSystemFromBackupResponse (..),
    newCreateFileSystemFromBackupResponse,

    -- * Response Lenses
    createFileSystemFromBackupResponse_fileSystem,
    createFileSystemFromBackupResponse_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 for the @CreateFileSystemFromBackup@ operation.
--
-- /See:/ 'newCreateFileSystemFromBackup' smart constructor.
data CreateFileSystemFromBackup = CreateFileSystemFromBackup'
  { -- | 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.
    CreateFileSystemFromBackup -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | Sets the version for the Amazon FSx for Lustre file system that you\'re
    -- creating from a backup. Valid values are @2.10@ and @2.12@.
    --
    -- You don\'t need to specify @FileSystemTypeVersion@ because it will be
    -- applied using the backup\'s @FileSystemTypeVersion@ setting. If you
    -- choose to specify @FileSystemTypeVersion@ when creating from backup, the
    -- value must match the backup\'s @FileSystemTypeVersion@ setting.
    CreateFileSystemFromBackup -> Maybe Text
fileSystemTypeVersion :: Prelude.Maybe Prelude.Text,
    CreateFileSystemFromBackup -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    CreateFileSystemFromBackup
-> Maybe CreateFileSystemLustreConfiguration
lustreConfiguration :: Prelude.Maybe CreateFileSystemLustreConfiguration,
    -- | The OpenZFS configuration for the file system that\'s being created.
    CreateFileSystemFromBackup
-> Maybe CreateFileSystemOpenZFSConfiguration
openZFSConfiguration :: Prelude.Maybe CreateFileSystemOpenZFSConfiguration,
    -- | A list of IDs for the security groups that apply to the specified
    -- network interfaces created for file system access. These security groups
    -- apply to all network interfaces. This value isn\'t returned in later
    -- @DescribeFileSystem@ requests.
    CreateFileSystemFromBackup -> Maybe [Text]
securityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | Sets the storage capacity of the OpenZFS file system that you\'re
    -- creating from a backup, in gibibytes (GiB). Valid values are from 64 GiB
    -- up to 524,288 GiB (512 TiB). However, the value that you specify must be
    -- equal to or greater than the backup\'s storage capacity value. If you
    -- don\'t use the @StorageCapacity@ parameter, the default is the backup\'s
    -- @StorageCapacity@ value.
    --
    -- If used to create a file system other than OpenZFS, you must provide a
    -- value that matches the backup\'s @StorageCapacity@ value. If you provide
    -- any other value, Amazon FSx responds with a 400 Bad Request.
    CreateFileSystemFromBackup -> Maybe Natural
storageCapacity :: Prelude.Maybe Prelude.Natural,
    -- | Sets the storage type for the Windows or OpenZFS file system that
    -- you\'re creating from a backup. Valid values are @SSD@ and @HDD@.
    --
    -- -   Set to @SSD@ to use solid state drive storage. SSD is supported on
    --     all Windows and OpenZFS deployment types.
    --
    -- -   Set to @HDD@ to use hard disk drive storage. HDD is supported on
    --     @SINGLE_AZ_2@ and @MULTI_AZ_1@ FSx for Windows File Server file
    --     system deployment types.
    --
    -- The default value is @SSD@.
    --
    -- HDD and SSD storage types have different minimum storage capacity
    -- requirements. A restored file system\'s storage capacity is tied to the
    -- file system that was backed up. You can create a file system that uses
    -- HDD storage from a backup of a file system that used SSD storage if the
    -- original SSD file system had a storage capacity of at least 2000 GiB.
    CreateFileSystemFromBackup -> Maybe StorageType
storageType :: Prelude.Maybe StorageType,
    -- | The tags to be applied to the file system at file system creation. The
    -- key value of the @Name@ tag appears in the console as the file system
    -- name.
    CreateFileSystemFromBackup -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The configuration for this Microsoft Windows file system.
    CreateFileSystemFromBackup
-> Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration :: Prelude.Maybe CreateFileSystemWindowsConfiguration,
    CreateFileSystemFromBackup -> Text
backupId :: Prelude.Text,
    -- | Specifies the IDs of the subnets that the file system will be accessible
    -- from. For Windows @MULTI_AZ_1@ file system 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@
    -- property.
    --
    -- Windows @SINGLE_AZ_1@ and @SINGLE_AZ_2@ file system deployment types,
    -- Lustre file systems, and OpenZFS file systems provide exactly one subnet
    -- ID. The file server is launched in that subnet\'s Availability Zone.
    CreateFileSystemFromBackup -> [Text]
subnetIds :: [Prelude.Text]
  }
  deriving (CreateFileSystemFromBackup -> CreateFileSystemFromBackup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFileSystemFromBackup -> CreateFileSystemFromBackup -> Bool
$c/= :: CreateFileSystemFromBackup -> CreateFileSystemFromBackup -> Bool
== :: CreateFileSystemFromBackup -> CreateFileSystemFromBackup -> Bool
$c== :: CreateFileSystemFromBackup -> CreateFileSystemFromBackup -> Bool
Prelude.Eq, Int -> CreateFileSystemFromBackup -> ShowS
[CreateFileSystemFromBackup] -> ShowS
CreateFileSystemFromBackup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFileSystemFromBackup] -> ShowS
$cshowList :: [CreateFileSystemFromBackup] -> ShowS
show :: CreateFileSystemFromBackup -> String
$cshow :: CreateFileSystemFromBackup -> String
showsPrec :: Int -> CreateFileSystemFromBackup -> ShowS
$cshowsPrec :: Int -> CreateFileSystemFromBackup -> ShowS
Prelude.Show, forall x.
Rep CreateFileSystemFromBackup x -> CreateFileSystemFromBackup
forall x.
CreateFileSystemFromBackup -> Rep CreateFileSystemFromBackup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateFileSystemFromBackup x -> CreateFileSystemFromBackup
$cfrom :: forall x.
CreateFileSystemFromBackup -> Rep CreateFileSystemFromBackup x
Prelude.Generic)

-- |
-- Create a value of 'CreateFileSystemFromBackup' 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', 'createFileSystemFromBackup_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', 'createFileSystemFromBackup_fileSystemTypeVersion' - Sets the version for the Amazon FSx for Lustre file system that you\'re
-- creating from a backup. Valid values are @2.10@ and @2.12@.
--
-- You don\'t need to specify @FileSystemTypeVersion@ because it will be
-- applied using the backup\'s @FileSystemTypeVersion@ setting. If you
-- choose to specify @FileSystemTypeVersion@ when creating from backup, the
-- value must match the backup\'s @FileSystemTypeVersion@ setting.
--
-- 'kmsKeyId', 'createFileSystemFromBackup_kmsKeyId' - Undocumented member.
--
-- 'lustreConfiguration', 'createFileSystemFromBackup_lustreConfiguration' - Undocumented member.
--
-- 'openZFSConfiguration', 'createFileSystemFromBackup_openZFSConfiguration' - The OpenZFS configuration for the file system that\'s being created.
--
-- 'securityGroupIds', 'createFileSystemFromBackup_securityGroupIds' - A list of IDs for the security groups that apply to the specified
-- network interfaces created for file system access. These security groups
-- apply to all network interfaces. This value isn\'t returned in later
-- @DescribeFileSystem@ requests.
--
-- 'storageCapacity', 'createFileSystemFromBackup_storageCapacity' - Sets the storage capacity of the OpenZFS file system that you\'re
-- creating from a backup, in gibibytes (GiB). Valid values are from 64 GiB
-- up to 524,288 GiB (512 TiB). However, the value that you specify must be
-- equal to or greater than the backup\'s storage capacity value. If you
-- don\'t use the @StorageCapacity@ parameter, the default is the backup\'s
-- @StorageCapacity@ value.
--
-- If used to create a file system other than OpenZFS, you must provide a
-- value that matches the backup\'s @StorageCapacity@ value. If you provide
-- any other value, Amazon FSx responds with a 400 Bad Request.
--
-- 'storageType', 'createFileSystemFromBackup_storageType' - Sets the storage type for the Windows or OpenZFS file system that
-- you\'re creating from a backup. Valid values are @SSD@ and @HDD@.
--
-- -   Set to @SSD@ to use solid state drive storage. SSD is supported on
--     all Windows and OpenZFS deployment types.
--
-- -   Set to @HDD@ to use hard disk drive storage. HDD is supported on
--     @SINGLE_AZ_2@ and @MULTI_AZ_1@ FSx for Windows File Server file
--     system deployment types.
--
-- The default value is @SSD@.
--
-- HDD and SSD storage types have different minimum storage capacity
-- requirements. A restored file system\'s storage capacity is tied to the
-- file system that was backed up. You can create a file system that uses
-- HDD storage from a backup of a file system that used SSD storage if the
-- original SSD file system had a storage capacity of at least 2000 GiB.
--
-- 'tags', 'createFileSystemFromBackup_tags' - The tags to be applied to the file system at file system creation. The
-- key value of the @Name@ tag appears in the console as the file system
-- name.
--
-- 'windowsConfiguration', 'createFileSystemFromBackup_windowsConfiguration' - The configuration for this Microsoft Windows file system.
--
-- 'backupId', 'createFileSystemFromBackup_backupId' - Undocumented member.
--
-- 'subnetIds', 'createFileSystemFromBackup_subnetIds' - Specifies the IDs of the subnets that the file system will be accessible
-- from. For Windows @MULTI_AZ_1@ file system 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@
-- property.
--
-- Windows @SINGLE_AZ_1@ and @SINGLE_AZ_2@ file system deployment types,
-- Lustre file systems, and OpenZFS file systems provide exactly one subnet
-- ID. The file server is launched in that subnet\'s Availability Zone.
newCreateFileSystemFromBackup ::
  -- | 'backupId'
  Prelude.Text ->
  CreateFileSystemFromBackup
newCreateFileSystemFromBackup :: Text -> CreateFileSystemFromBackup
newCreateFileSystemFromBackup Text
pBackupId_ =
  CreateFileSystemFromBackup'
    { $sel:clientRequestToken:CreateFileSystemFromBackup' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:fileSystemTypeVersion:CreateFileSystemFromBackup' :: Maybe Text
fileSystemTypeVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:CreateFileSystemFromBackup' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:lustreConfiguration:CreateFileSystemFromBackup' :: Maybe CreateFileSystemLustreConfiguration
lustreConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:openZFSConfiguration:CreateFileSystemFromBackup' :: Maybe CreateFileSystemOpenZFSConfiguration
openZFSConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroupIds:CreateFileSystemFromBackup' :: Maybe [Text]
securityGroupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:storageCapacity:CreateFileSystemFromBackup' :: Maybe Natural
storageCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:storageType:CreateFileSystemFromBackup' :: Maybe StorageType
storageType = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateFileSystemFromBackup' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:windowsConfiguration:CreateFileSystemFromBackup' :: Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:backupId:CreateFileSystemFromBackup' :: Text
backupId = Text
pBackupId_,
      $sel:subnetIds:CreateFileSystemFromBackup' :: [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.
createFileSystemFromBackup_clientRequestToken :: Lens.Lens' CreateFileSystemFromBackup (Prelude.Maybe Prelude.Text)
createFileSystemFromBackup_clientRequestToken :: Lens' CreateFileSystemFromBackup (Maybe Text)
createFileSystemFromBackup_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystemFromBackup' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreateFileSystemFromBackup
s@CreateFileSystemFromBackup' {} Maybe Text
a -> CreateFileSystemFromBackup
s {$sel:clientRequestToken:CreateFileSystemFromBackup' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreateFileSystemFromBackup)

-- | Sets the version for the Amazon FSx for Lustre file system that you\'re
-- creating from a backup. Valid values are @2.10@ and @2.12@.
--
-- You don\'t need to specify @FileSystemTypeVersion@ because it will be
-- applied using the backup\'s @FileSystemTypeVersion@ setting. If you
-- choose to specify @FileSystemTypeVersion@ when creating from backup, the
-- value must match the backup\'s @FileSystemTypeVersion@ setting.
createFileSystemFromBackup_fileSystemTypeVersion :: Lens.Lens' CreateFileSystemFromBackup (Prelude.Maybe Prelude.Text)
createFileSystemFromBackup_fileSystemTypeVersion :: Lens' CreateFileSystemFromBackup (Maybe Text)
createFileSystemFromBackup_fileSystemTypeVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystemFromBackup' {Maybe Text
fileSystemTypeVersion :: Maybe Text
$sel:fileSystemTypeVersion:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe Text
fileSystemTypeVersion} -> Maybe Text
fileSystemTypeVersion) (\s :: CreateFileSystemFromBackup
s@CreateFileSystemFromBackup' {} Maybe Text
a -> CreateFileSystemFromBackup
s {$sel:fileSystemTypeVersion:CreateFileSystemFromBackup' :: Maybe Text
fileSystemTypeVersion = Maybe Text
a} :: CreateFileSystemFromBackup)

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

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

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

-- | A list of IDs for the security groups that apply to the specified
-- network interfaces created for file system access. These security groups
-- apply to all network interfaces. This value isn\'t returned in later
-- @DescribeFileSystem@ requests.
createFileSystemFromBackup_securityGroupIds :: Lens.Lens' CreateFileSystemFromBackup (Prelude.Maybe [Prelude.Text])
createFileSystemFromBackup_securityGroupIds :: Lens' CreateFileSystemFromBackup (Maybe [Text])
createFileSystemFromBackup_securityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystemFromBackup' {Maybe [Text]
securityGroupIds :: Maybe [Text]
$sel:securityGroupIds:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe [Text]
securityGroupIds} -> Maybe [Text]
securityGroupIds) (\s :: CreateFileSystemFromBackup
s@CreateFileSystemFromBackup' {} Maybe [Text]
a -> CreateFileSystemFromBackup
s {$sel:securityGroupIds:CreateFileSystemFromBackup' :: Maybe [Text]
securityGroupIds = Maybe [Text]
a} :: CreateFileSystemFromBackup) 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 capacity of the OpenZFS file system that you\'re
-- creating from a backup, in gibibytes (GiB). Valid values are from 64 GiB
-- up to 524,288 GiB (512 TiB). However, the value that you specify must be
-- equal to or greater than the backup\'s storage capacity value. If you
-- don\'t use the @StorageCapacity@ parameter, the default is the backup\'s
-- @StorageCapacity@ value.
--
-- If used to create a file system other than OpenZFS, you must provide a
-- value that matches the backup\'s @StorageCapacity@ value. If you provide
-- any other value, Amazon FSx responds with a 400 Bad Request.
createFileSystemFromBackup_storageCapacity :: Lens.Lens' CreateFileSystemFromBackup (Prelude.Maybe Prelude.Natural)
createFileSystemFromBackup_storageCapacity :: Lens' CreateFileSystemFromBackup (Maybe Natural)
createFileSystemFromBackup_storageCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystemFromBackup' {Maybe Natural
storageCapacity :: Maybe Natural
$sel:storageCapacity:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe Natural
storageCapacity} -> Maybe Natural
storageCapacity) (\s :: CreateFileSystemFromBackup
s@CreateFileSystemFromBackup' {} Maybe Natural
a -> CreateFileSystemFromBackup
s {$sel:storageCapacity:CreateFileSystemFromBackup' :: Maybe Natural
storageCapacity = Maybe Natural
a} :: CreateFileSystemFromBackup)

-- | Sets the storage type for the Windows or OpenZFS file system that
-- you\'re creating from a backup. Valid values are @SSD@ and @HDD@.
--
-- -   Set to @SSD@ to use solid state drive storage. SSD is supported on
--     all Windows and OpenZFS deployment types.
--
-- -   Set to @HDD@ to use hard disk drive storage. HDD is supported on
--     @SINGLE_AZ_2@ and @MULTI_AZ_1@ FSx for Windows File Server file
--     system deployment types.
--
-- The default value is @SSD@.
--
-- HDD and SSD storage types have different minimum storage capacity
-- requirements. A restored file system\'s storage capacity is tied to the
-- file system that was backed up. You can create a file system that uses
-- HDD storage from a backup of a file system that used SSD storage if the
-- original SSD file system had a storage capacity of at least 2000 GiB.
createFileSystemFromBackup_storageType :: Lens.Lens' CreateFileSystemFromBackup (Prelude.Maybe StorageType)
createFileSystemFromBackup_storageType :: Lens' CreateFileSystemFromBackup (Maybe StorageType)
createFileSystemFromBackup_storageType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystemFromBackup' {Maybe StorageType
storageType :: Maybe StorageType
$sel:storageType:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe StorageType
storageType} -> Maybe StorageType
storageType) (\s :: CreateFileSystemFromBackup
s@CreateFileSystemFromBackup' {} Maybe StorageType
a -> CreateFileSystemFromBackup
s {$sel:storageType:CreateFileSystemFromBackup' :: Maybe StorageType
storageType = Maybe StorageType
a} :: CreateFileSystemFromBackup)

-- | The tags to be applied to the file system at file system creation. The
-- key value of the @Name@ tag appears in the console as the file system
-- name.
createFileSystemFromBackup_tags :: Lens.Lens' CreateFileSystemFromBackup (Prelude.Maybe (Prelude.NonEmpty Tag))
createFileSystemFromBackup_tags :: Lens' CreateFileSystemFromBackup (Maybe (NonEmpty Tag))
createFileSystemFromBackup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystemFromBackup' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateFileSystemFromBackup
s@CreateFileSystemFromBackup' {} Maybe (NonEmpty Tag)
a -> CreateFileSystemFromBackup
s {$sel:tags:CreateFileSystemFromBackup' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateFileSystemFromBackup) 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 configuration for this Microsoft Windows file system.
createFileSystemFromBackup_windowsConfiguration :: Lens.Lens' CreateFileSystemFromBackup (Prelude.Maybe CreateFileSystemWindowsConfiguration)
createFileSystemFromBackup_windowsConfiguration :: Lens'
  CreateFileSystemFromBackup
  (Maybe CreateFileSystemWindowsConfiguration)
createFileSystemFromBackup_windowsConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystemFromBackup' {Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration :: Maybe CreateFileSystemWindowsConfiguration
$sel:windowsConfiguration:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup
-> Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration} -> Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration) (\s :: CreateFileSystemFromBackup
s@CreateFileSystemFromBackup' {} Maybe CreateFileSystemWindowsConfiguration
a -> CreateFileSystemFromBackup
s {$sel:windowsConfiguration:CreateFileSystemFromBackup' :: Maybe CreateFileSystemWindowsConfiguration
windowsConfiguration = Maybe CreateFileSystemWindowsConfiguration
a} :: CreateFileSystemFromBackup)

-- | Undocumented member.
createFileSystemFromBackup_backupId :: Lens.Lens' CreateFileSystemFromBackup Prelude.Text
createFileSystemFromBackup_backupId :: Lens' CreateFileSystemFromBackup Text
createFileSystemFromBackup_backupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystemFromBackup' {Text
backupId :: Text
$sel:backupId:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Text
backupId} -> Text
backupId) (\s :: CreateFileSystemFromBackup
s@CreateFileSystemFromBackup' {} Text
a -> CreateFileSystemFromBackup
s {$sel:backupId:CreateFileSystemFromBackup' :: Text
backupId = Text
a} :: CreateFileSystemFromBackup)

-- | Specifies the IDs of the subnets that the file system will be accessible
-- from. For Windows @MULTI_AZ_1@ file system 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@
-- property.
--
-- Windows @SINGLE_AZ_1@ and @SINGLE_AZ_2@ file system deployment types,
-- Lustre file systems, and OpenZFS file systems provide exactly one subnet
-- ID. The file server is launched in that subnet\'s Availability Zone.
createFileSystemFromBackup_subnetIds :: Lens.Lens' CreateFileSystemFromBackup [Prelude.Text]
createFileSystemFromBackup_subnetIds :: Lens' CreateFileSystemFromBackup [Text]
createFileSystemFromBackup_subnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystemFromBackup' {[Text]
subnetIds :: [Text]
$sel:subnetIds:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> [Text]
subnetIds} -> [Text]
subnetIds) (\s :: CreateFileSystemFromBackup
s@CreateFileSystemFromBackup' {} [Text]
a -> CreateFileSystemFromBackup
s {$sel:subnetIds:CreateFileSystemFromBackup' :: [Text]
subnetIds = [Text]
a} :: CreateFileSystemFromBackup) 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 CreateFileSystemFromBackup where
  type
    AWSResponse CreateFileSystemFromBackup =
      CreateFileSystemFromBackupResponse
  request :: (Service -> Service)
-> CreateFileSystemFromBackup -> Request CreateFileSystemFromBackup
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 CreateFileSystemFromBackup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateFileSystemFromBackup)))
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 -> CreateFileSystemFromBackupResponse
CreateFileSystemFromBackupResponse'
            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 CreateFileSystemFromBackup where
  hashWithSalt :: Int -> CreateFileSystemFromBackup -> Int
hashWithSalt Int
_salt CreateFileSystemFromBackup' {[Text]
Maybe Natural
Maybe [Text]
Maybe (NonEmpty Tag)
Maybe Text
Maybe CreateFileSystemLustreConfiguration
Maybe CreateFileSystemOpenZFSConfiguration
Maybe StorageType
Maybe CreateFileSystemWindowsConfiguration
Text
subnetIds :: [Text]
backupId :: Text
windowsConfiguration :: Maybe CreateFileSystemWindowsConfiguration
tags :: Maybe (NonEmpty Tag)
storageType :: Maybe StorageType
storageCapacity :: Maybe Natural
securityGroupIds :: Maybe [Text]
openZFSConfiguration :: Maybe CreateFileSystemOpenZFSConfiguration
lustreConfiguration :: Maybe CreateFileSystemLustreConfiguration
kmsKeyId :: Maybe Text
fileSystemTypeVersion :: Maybe Text
clientRequestToken :: Maybe Text
$sel:subnetIds:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> [Text]
$sel:backupId:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Text
$sel:windowsConfiguration:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup
-> Maybe CreateFileSystemWindowsConfiguration
$sel:tags:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe (NonEmpty Tag)
$sel:storageType:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe StorageType
$sel:storageCapacity:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe Natural
$sel:securityGroupIds:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe [Text]
$sel:openZFSConfiguration:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup
-> Maybe CreateFileSystemOpenZFSConfiguration
$sel:lustreConfiguration:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup
-> Maybe CreateFileSystemLustreConfiguration
$sel:kmsKeyId:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe Text
$sel:fileSystemTypeVersion:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe Text
$sel:clientRequestToken:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> 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 CreateFileSystemOpenZFSConfiguration
openZFSConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
storageCapacity
      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` Text
backupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
subnetIds

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

instance Data.ToHeaders CreateFileSystemFromBackup where
  toHeaders :: CreateFileSystemFromBackup -> 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.CreateFileSystemFromBackup" ::
                          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 CreateFileSystemFromBackup where
  toJSON :: CreateFileSystemFromBackup -> Value
toJSON CreateFileSystemFromBackup' {[Text]
Maybe Natural
Maybe [Text]
Maybe (NonEmpty Tag)
Maybe Text
Maybe CreateFileSystemLustreConfiguration
Maybe CreateFileSystemOpenZFSConfiguration
Maybe StorageType
Maybe CreateFileSystemWindowsConfiguration
Text
subnetIds :: [Text]
backupId :: Text
windowsConfiguration :: Maybe CreateFileSystemWindowsConfiguration
tags :: Maybe (NonEmpty Tag)
storageType :: Maybe StorageType
storageCapacity :: Maybe Natural
securityGroupIds :: Maybe [Text]
openZFSConfiguration :: Maybe CreateFileSystemOpenZFSConfiguration
lustreConfiguration :: Maybe CreateFileSystemLustreConfiguration
kmsKeyId :: Maybe Text
fileSystemTypeVersion :: Maybe Text
clientRequestToken :: Maybe Text
$sel:subnetIds:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> [Text]
$sel:backupId:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Text
$sel:windowsConfiguration:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup
-> Maybe CreateFileSystemWindowsConfiguration
$sel:tags:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe (NonEmpty Tag)
$sel:storageType:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe StorageType
$sel:storageCapacity:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe Natural
$sel:securityGroupIds:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe [Text]
$sel:openZFSConfiguration:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup
-> Maybe CreateFileSystemOpenZFSConfiguration
$sel:lustreConfiguration:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup
-> Maybe CreateFileSystemLustreConfiguration
$sel:kmsKeyId:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe Text
$sel:fileSystemTypeVersion:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> Maybe Text
$sel:clientRequestToken:CreateFileSystemFromBackup' :: CreateFileSystemFromBackup -> 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
"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
"StorageCapacity" 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 Natural
storageCapacity,
            (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
"BackupId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
backupId),
            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 CreateFileSystemFromBackup where
  toPath :: CreateFileSystemFromBackup -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'CreateFileSystemFromBackupResponse' 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', 'createFileSystemFromBackupResponse_fileSystem' - A description of the file system.
--
-- 'httpStatus', 'createFileSystemFromBackupResponse_httpStatus' - The response's http status code.
newCreateFileSystemFromBackupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateFileSystemFromBackupResponse
newCreateFileSystemFromBackupResponse :: Int -> CreateFileSystemFromBackupResponse
newCreateFileSystemFromBackupResponse Int
pHttpStatus_ =
  CreateFileSystemFromBackupResponse'
    { $sel:fileSystem:CreateFileSystemFromBackupResponse' :: Maybe FileSystem
fileSystem =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateFileSystemFromBackupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A description of the file system.
createFileSystemFromBackupResponse_fileSystem :: Lens.Lens' CreateFileSystemFromBackupResponse (Prelude.Maybe FileSystem)
createFileSystemFromBackupResponse_fileSystem :: Lens' CreateFileSystemFromBackupResponse (Maybe FileSystem)
createFileSystemFromBackupResponse_fileSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileSystemFromBackupResponse' {Maybe FileSystem
fileSystem :: Maybe FileSystem
$sel:fileSystem:CreateFileSystemFromBackupResponse' :: CreateFileSystemFromBackupResponse -> Maybe FileSystem
fileSystem} -> Maybe FileSystem
fileSystem) (\s :: CreateFileSystemFromBackupResponse
s@CreateFileSystemFromBackupResponse' {} Maybe FileSystem
a -> CreateFileSystemFromBackupResponse
s {$sel:fileSystem:CreateFileSystemFromBackupResponse' :: Maybe FileSystem
fileSystem = Maybe FileSystem
a} :: CreateFileSystemFromBackupResponse)

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

instance
  Prelude.NFData
    CreateFileSystemFromBackupResponse
  where
  rnf :: CreateFileSystemFromBackupResponse -> ()
rnf CreateFileSystemFromBackupResponse' {Int
Maybe FileSystem
httpStatus :: Int
fileSystem :: Maybe FileSystem
$sel:httpStatus:CreateFileSystemFromBackupResponse' :: CreateFileSystemFromBackupResponse -> Int
$sel:fileSystem:CreateFileSystemFromBackupResponse' :: CreateFileSystemFromBackupResponse -> 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