{-# 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.UpdateFileSystem
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use this operation to update the configuration of an existing Amazon FSx
-- file system. You can update multiple properties in a single request.
--
-- For Amazon FSx for Windows File Server file systems, you can update the
-- following properties:
--
-- -   @AuditLogConfiguration@
--
-- -   @AutomaticBackupRetentionDays@
--
-- -   @DailyAutomaticBackupStartTime@
--
-- -   @SelfManagedActiveDirectoryConfiguration@
--
-- -   @StorageCapacity@
--
-- -   @ThroughputCapacity@
--
-- -   @WeeklyMaintenanceStartTime@
--
-- For Amazon FSx for Lustre file systems, you can update the following
-- properties:
--
-- -   @AutoImportPolicy@
--
-- -   @AutomaticBackupRetentionDays@
--
-- -   @DailyAutomaticBackupStartTime@
--
-- -   @DataCompressionType@
--
-- -   @LustreRootSquashConfiguration@
--
-- -   @StorageCapacity@
--
-- -   @WeeklyMaintenanceStartTime@
--
-- For Amazon FSx for NetApp ONTAP file systems, you can update the
-- following properties:
--
-- -   @AutomaticBackupRetentionDays@
--
-- -   @DailyAutomaticBackupStartTime@
--
-- -   @DiskIopsConfiguration@
--
-- -   @FsxAdminPassword@
--
-- -   @StorageCapacity@
--
-- -   @ThroughputCapacity@
--
-- -   @WeeklyMaintenanceStartTime@
--
-- For the Amazon FSx for OpenZFS file systems, you can update the
-- following properties:
--
-- -   @AutomaticBackupRetentionDays@
--
-- -   @CopyTagsToBackups@
--
-- -   @CopyTagsToVolumes@
--
-- -   @DailyAutomaticBackupStartTime@
--
-- -   @ThroughputCapacity@
--
-- -   @WeeklyMaintenanceStartTime@
module Amazonka.FSx.UpdateFileSystem
  ( -- * Creating a Request
    UpdateFileSystem (..),
    newUpdateFileSystem,

    -- * Request Lenses
    updateFileSystem_clientRequestToken,
    updateFileSystem_lustreConfiguration,
    updateFileSystem_ontapConfiguration,
    updateFileSystem_openZFSConfiguration,
    updateFileSystem_storageCapacity,
    updateFileSystem_windowsConfiguration,
    updateFileSystem_fileSystemId,

    -- * Destructuring the Response
    UpdateFileSystemResponse (..),
    newUpdateFileSystemResponse,

    -- * Response Lenses
    updateFileSystemResponse_fileSystem,
    updateFileSystemResponse_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 @UpdateFileSystem@ operation.
--
-- /See:/ 'newUpdateFileSystem' smart constructor.
data UpdateFileSystem = UpdateFileSystem'
  { -- | A string of up to 64 ASCII characters that Amazon FSx uses to ensure
    -- idempotent updates. This string is automatically filled on your behalf
    -- when you use the Command Line Interface (CLI) or an Amazon Web Services
    -- SDK.
    UpdateFileSystem -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    UpdateFileSystem -> Maybe UpdateFileSystemLustreConfiguration
lustreConfiguration :: Prelude.Maybe UpdateFileSystemLustreConfiguration,
    UpdateFileSystem -> Maybe UpdateFileSystemOntapConfiguration
ontapConfiguration :: Prelude.Maybe UpdateFileSystemOntapConfiguration,
    -- | The configuration updates for an Amazon FSx for OpenZFS file system.
    UpdateFileSystem -> Maybe UpdateFileSystemOpenZFSConfiguration
openZFSConfiguration :: Prelude.Maybe UpdateFileSystemOpenZFSConfiguration,
    -- | Use this parameter to increase the storage capacity of an Amazon FSx for
    -- Windows File Server, Amazon FSx for Lustre, or Amazon FSx for NetApp
    -- ONTAP file system. Specifies the storage capacity target value, in GiB,
    -- to increase the storage capacity for the file system that you\'re
    -- updating.
    --
    -- You can\'t make a storage capacity increase request if there is an
    -- existing storage capacity increase request in progress.
    --
    -- For Windows file systems, the storage capacity target value must be at
    -- least 10 percent greater than the current storage capacity value. To
    -- increase storage capacity, the file system must have at least 16 MBps of
    -- throughput capacity. For more information, see
    -- <https://docs.aws.amazon.com/fsx/latest/WindowsGuide/managing-storage-capacity.html Managing storage capacity>
    -- in the /Amazon FSx for Windows File Server User Guide/.
    --
    -- For Lustre file systems, the storage capacity target value can be the
    -- following:
    --
    -- -   For @SCRATCH_2@, @PERSISTENT_1@, and @PERSISTENT_2 SSD@ deployment
    --     types, valid values are in multiples of 2400 GiB. The value must be
    --     greater than the current storage capacity.
    --
    -- -   For @PERSISTENT HDD@ file systems, valid values are multiples of
    --     6000 GiB for 12-MBps throughput per TiB file systems and multiples
    --     of 1800 GiB for 40-MBps throughput per TiB file systems. The values
    --     must be greater than the current storage capacity.
    --
    -- -   For @SCRATCH_1@ file systems, you can\'t increase the storage
    --     capacity.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/managing-storage-capacity.html Managing storage and throughput capacity>
    -- in the /Amazon FSx for Lustre User Guide/.
    --
    -- For ONTAP file systems, the storage capacity target value must be at
    -- least 10 percent greater than the current storage capacity value. For
    -- more information, see
    -- <https://docs.aws.amazon.com/fsx/latest/ONTAPGuide/managing-storage-capacity.html Managing storage capacity and provisioned IOPS>
    -- in the /Amazon FSx for NetApp ONTAP User Guide/.
    UpdateFileSystem -> Maybe Natural
storageCapacity :: Prelude.Maybe Prelude.Natural,
    -- | The configuration updates for an Amazon FSx for Windows File Server file
    -- system.
    UpdateFileSystem -> Maybe UpdateFileSystemWindowsConfiguration
windowsConfiguration :: Prelude.Maybe UpdateFileSystemWindowsConfiguration,
    -- | The ID of the file system that you are updating.
    UpdateFileSystem -> Text
fileSystemId :: Prelude.Text
  }
  deriving (UpdateFileSystem -> UpdateFileSystem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFileSystem -> UpdateFileSystem -> Bool
$c/= :: UpdateFileSystem -> UpdateFileSystem -> Bool
== :: UpdateFileSystem -> UpdateFileSystem -> Bool
$c== :: UpdateFileSystem -> UpdateFileSystem -> Bool
Prelude.Eq, Int -> UpdateFileSystem -> ShowS
[UpdateFileSystem] -> ShowS
UpdateFileSystem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFileSystem] -> ShowS
$cshowList :: [UpdateFileSystem] -> ShowS
show :: UpdateFileSystem -> String
$cshow :: UpdateFileSystem -> String
showsPrec :: Int -> UpdateFileSystem -> ShowS
$cshowsPrec :: Int -> UpdateFileSystem -> ShowS
Prelude.Show, forall x. Rep UpdateFileSystem x -> UpdateFileSystem
forall x. UpdateFileSystem -> Rep UpdateFileSystem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFileSystem x -> UpdateFileSystem
$cfrom :: forall x. UpdateFileSystem -> Rep UpdateFileSystem x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFileSystem' 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', 'updateFileSystem_clientRequestToken' - A string of up to 64 ASCII characters that Amazon FSx uses to ensure
-- idempotent updates. This string is automatically filled on your behalf
-- when you use the Command Line Interface (CLI) or an Amazon Web Services
-- SDK.
--
-- 'lustreConfiguration', 'updateFileSystem_lustreConfiguration' - Undocumented member.
--
-- 'ontapConfiguration', 'updateFileSystem_ontapConfiguration' - Undocumented member.
--
-- 'openZFSConfiguration', 'updateFileSystem_openZFSConfiguration' - The configuration updates for an Amazon FSx for OpenZFS file system.
--
-- 'storageCapacity', 'updateFileSystem_storageCapacity' - Use this parameter to increase the storage capacity of an Amazon FSx for
-- Windows File Server, Amazon FSx for Lustre, or Amazon FSx for NetApp
-- ONTAP file system. Specifies the storage capacity target value, in GiB,
-- to increase the storage capacity for the file system that you\'re
-- updating.
--
-- You can\'t make a storage capacity increase request if there is an
-- existing storage capacity increase request in progress.
--
-- For Windows file systems, the storage capacity target value must be at
-- least 10 percent greater than the current storage capacity value. To
-- increase storage capacity, the file system must have at least 16 MBps of
-- throughput capacity. For more information, see
-- <https://docs.aws.amazon.com/fsx/latest/WindowsGuide/managing-storage-capacity.html Managing storage capacity>
-- in the /Amazon FSx for Windows File Server User Guide/.
--
-- For Lustre file systems, the storage capacity target value can be the
-- following:
--
-- -   For @SCRATCH_2@, @PERSISTENT_1@, and @PERSISTENT_2 SSD@ deployment
--     types, valid values are in multiples of 2400 GiB. The value must be
--     greater than the current storage capacity.
--
-- -   For @PERSISTENT HDD@ file systems, valid values are multiples of
--     6000 GiB for 12-MBps throughput per TiB file systems and multiples
--     of 1800 GiB for 40-MBps throughput per TiB file systems. The values
--     must be greater than the current storage capacity.
--
-- -   For @SCRATCH_1@ file systems, you can\'t increase the storage
--     capacity.
--
-- For more information, see
-- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/managing-storage-capacity.html Managing storage and throughput capacity>
-- in the /Amazon FSx for Lustre User Guide/.
--
-- For ONTAP file systems, the storage capacity target value must be at
-- least 10 percent greater than the current storage capacity value. For
-- more information, see
-- <https://docs.aws.amazon.com/fsx/latest/ONTAPGuide/managing-storage-capacity.html Managing storage capacity and provisioned IOPS>
-- in the /Amazon FSx for NetApp ONTAP User Guide/.
--
-- 'windowsConfiguration', 'updateFileSystem_windowsConfiguration' - The configuration updates for an Amazon FSx for Windows File Server file
-- system.
--
-- 'fileSystemId', 'updateFileSystem_fileSystemId' - The ID of the file system that you are updating.
newUpdateFileSystem ::
  -- | 'fileSystemId'
  Prelude.Text ->
  UpdateFileSystem
newUpdateFileSystem :: Text -> UpdateFileSystem
newUpdateFileSystem Text
pFileSystemId_ =
  UpdateFileSystem'
    { $sel:clientRequestToken:UpdateFileSystem' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:lustreConfiguration:UpdateFileSystem' :: Maybe UpdateFileSystemLustreConfiguration
lustreConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:ontapConfiguration:UpdateFileSystem' :: Maybe UpdateFileSystemOntapConfiguration
ontapConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:openZFSConfiguration:UpdateFileSystem' :: Maybe UpdateFileSystemOpenZFSConfiguration
openZFSConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:storageCapacity:UpdateFileSystem' :: Maybe Natural
storageCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:windowsConfiguration:UpdateFileSystem' :: Maybe UpdateFileSystemWindowsConfiguration
windowsConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:fileSystemId:UpdateFileSystem' :: Text
fileSystemId = Text
pFileSystemId_
    }

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

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

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

-- | The configuration updates for an Amazon FSx for OpenZFS file system.
updateFileSystem_openZFSConfiguration :: Lens.Lens' UpdateFileSystem (Prelude.Maybe UpdateFileSystemOpenZFSConfiguration)
updateFileSystem_openZFSConfiguration :: Lens' UpdateFileSystem (Maybe UpdateFileSystemOpenZFSConfiguration)
updateFileSystem_openZFSConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFileSystem' {Maybe UpdateFileSystemOpenZFSConfiguration
openZFSConfiguration :: Maybe UpdateFileSystemOpenZFSConfiguration
$sel:openZFSConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemOpenZFSConfiguration
openZFSConfiguration} -> Maybe UpdateFileSystemOpenZFSConfiguration
openZFSConfiguration) (\s :: UpdateFileSystem
s@UpdateFileSystem' {} Maybe UpdateFileSystemOpenZFSConfiguration
a -> UpdateFileSystem
s {$sel:openZFSConfiguration:UpdateFileSystem' :: Maybe UpdateFileSystemOpenZFSConfiguration
openZFSConfiguration = Maybe UpdateFileSystemOpenZFSConfiguration
a} :: UpdateFileSystem)

-- | Use this parameter to increase the storage capacity of an Amazon FSx for
-- Windows File Server, Amazon FSx for Lustre, or Amazon FSx for NetApp
-- ONTAP file system. Specifies the storage capacity target value, in GiB,
-- to increase the storage capacity for the file system that you\'re
-- updating.
--
-- You can\'t make a storage capacity increase request if there is an
-- existing storage capacity increase request in progress.
--
-- For Windows file systems, the storage capacity target value must be at
-- least 10 percent greater than the current storage capacity value. To
-- increase storage capacity, the file system must have at least 16 MBps of
-- throughput capacity. For more information, see
-- <https://docs.aws.amazon.com/fsx/latest/WindowsGuide/managing-storage-capacity.html Managing storage capacity>
-- in the /Amazon FSx for Windows File Server User Guide/.
--
-- For Lustre file systems, the storage capacity target value can be the
-- following:
--
-- -   For @SCRATCH_2@, @PERSISTENT_1@, and @PERSISTENT_2 SSD@ deployment
--     types, valid values are in multiples of 2400 GiB. The value must be
--     greater than the current storage capacity.
--
-- -   For @PERSISTENT HDD@ file systems, valid values are multiples of
--     6000 GiB for 12-MBps throughput per TiB file systems and multiples
--     of 1800 GiB for 40-MBps throughput per TiB file systems. The values
--     must be greater than the current storage capacity.
--
-- -   For @SCRATCH_1@ file systems, you can\'t increase the storage
--     capacity.
--
-- For more information, see
-- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/managing-storage-capacity.html Managing storage and throughput capacity>
-- in the /Amazon FSx for Lustre User Guide/.
--
-- For ONTAP file systems, the storage capacity target value must be at
-- least 10 percent greater than the current storage capacity value. For
-- more information, see
-- <https://docs.aws.amazon.com/fsx/latest/ONTAPGuide/managing-storage-capacity.html Managing storage capacity and provisioned IOPS>
-- in the /Amazon FSx for NetApp ONTAP User Guide/.
updateFileSystem_storageCapacity :: Lens.Lens' UpdateFileSystem (Prelude.Maybe Prelude.Natural)
updateFileSystem_storageCapacity :: Lens' UpdateFileSystem (Maybe Natural)
updateFileSystem_storageCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFileSystem' {Maybe Natural
storageCapacity :: Maybe Natural
$sel:storageCapacity:UpdateFileSystem' :: UpdateFileSystem -> Maybe Natural
storageCapacity} -> Maybe Natural
storageCapacity) (\s :: UpdateFileSystem
s@UpdateFileSystem' {} Maybe Natural
a -> UpdateFileSystem
s {$sel:storageCapacity:UpdateFileSystem' :: Maybe Natural
storageCapacity = Maybe Natural
a} :: UpdateFileSystem)

-- | The configuration updates for an Amazon FSx for Windows File Server file
-- system.
updateFileSystem_windowsConfiguration :: Lens.Lens' UpdateFileSystem (Prelude.Maybe UpdateFileSystemWindowsConfiguration)
updateFileSystem_windowsConfiguration :: Lens' UpdateFileSystem (Maybe UpdateFileSystemWindowsConfiguration)
updateFileSystem_windowsConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFileSystem' {Maybe UpdateFileSystemWindowsConfiguration
windowsConfiguration :: Maybe UpdateFileSystemWindowsConfiguration
$sel:windowsConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemWindowsConfiguration
windowsConfiguration} -> Maybe UpdateFileSystemWindowsConfiguration
windowsConfiguration) (\s :: UpdateFileSystem
s@UpdateFileSystem' {} Maybe UpdateFileSystemWindowsConfiguration
a -> UpdateFileSystem
s {$sel:windowsConfiguration:UpdateFileSystem' :: Maybe UpdateFileSystemWindowsConfiguration
windowsConfiguration = Maybe UpdateFileSystemWindowsConfiguration
a} :: UpdateFileSystem)

-- | The ID of the file system that you are updating.
updateFileSystem_fileSystemId :: Lens.Lens' UpdateFileSystem Prelude.Text
updateFileSystem_fileSystemId :: Lens' UpdateFileSystem Text
updateFileSystem_fileSystemId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFileSystem' {Text
fileSystemId :: Text
$sel:fileSystemId:UpdateFileSystem' :: UpdateFileSystem -> Text
fileSystemId} -> Text
fileSystemId) (\s :: UpdateFileSystem
s@UpdateFileSystem' {} Text
a -> UpdateFileSystem
s {$sel:fileSystemId:UpdateFileSystem' :: Text
fileSystemId = Text
a} :: UpdateFileSystem)

instance Core.AWSRequest UpdateFileSystem where
  type
    AWSResponse UpdateFileSystem =
      UpdateFileSystemResponse
  request :: (Service -> Service)
-> UpdateFileSystem -> Request UpdateFileSystem
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 UpdateFileSystem
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateFileSystem)))
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 -> UpdateFileSystemResponse
UpdateFileSystemResponse'
            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 UpdateFileSystem where
  hashWithSalt :: Int -> UpdateFileSystem -> Int
hashWithSalt Int
_salt UpdateFileSystem' {Maybe Natural
Maybe Text
Maybe UpdateFileSystemLustreConfiguration
Maybe UpdateFileSystemOntapConfiguration
Maybe UpdateFileSystemOpenZFSConfiguration
Maybe UpdateFileSystemWindowsConfiguration
Text
fileSystemId :: Text
windowsConfiguration :: Maybe UpdateFileSystemWindowsConfiguration
storageCapacity :: Maybe Natural
openZFSConfiguration :: Maybe UpdateFileSystemOpenZFSConfiguration
ontapConfiguration :: Maybe UpdateFileSystemOntapConfiguration
lustreConfiguration :: Maybe UpdateFileSystemLustreConfiguration
clientRequestToken :: Maybe Text
$sel:fileSystemId:UpdateFileSystem' :: UpdateFileSystem -> Text
$sel:windowsConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemWindowsConfiguration
$sel:storageCapacity:UpdateFileSystem' :: UpdateFileSystem -> Maybe Natural
$sel:openZFSConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemOpenZFSConfiguration
$sel:ontapConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemOntapConfiguration
$sel:lustreConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemLustreConfiguration
$sel:clientRequestToken:UpdateFileSystem' :: UpdateFileSystem -> 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 UpdateFileSystemLustreConfiguration
lustreConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdateFileSystemOntapConfiguration
ontapConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdateFileSystemOpenZFSConfiguration
openZFSConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
storageCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdateFileSystemWindowsConfiguration
windowsConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fileSystemId

instance Prelude.NFData UpdateFileSystem where
  rnf :: UpdateFileSystem -> ()
rnf UpdateFileSystem' {Maybe Natural
Maybe Text
Maybe UpdateFileSystemLustreConfiguration
Maybe UpdateFileSystemOntapConfiguration
Maybe UpdateFileSystemOpenZFSConfiguration
Maybe UpdateFileSystemWindowsConfiguration
Text
fileSystemId :: Text
windowsConfiguration :: Maybe UpdateFileSystemWindowsConfiguration
storageCapacity :: Maybe Natural
openZFSConfiguration :: Maybe UpdateFileSystemOpenZFSConfiguration
ontapConfiguration :: Maybe UpdateFileSystemOntapConfiguration
lustreConfiguration :: Maybe UpdateFileSystemLustreConfiguration
clientRequestToken :: Maybe Text
$sel:fileSystemId:UpdateFileSystem' :: UpdateFileSystem -> Text
$sel:windowsConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemWindowsConfiguration
$sel:storageCapacity:UpdateFileSystem' :: UpdateFileSystem -> Maybe Natural
$sel:openZFSConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemOpenZFSConfiguration
$sel:ontapConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemOntapConfiguration
$sel:lustreConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemLustreConfiguration
$sel:clientRequestToken:UpdateFileSystem' :: UpdateFileSystem -> 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 UpdateFileSystemLustreConfiguration
lustreConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UpdateFileSystemOntapConfiguration
ontapConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UpdateFileSystemOpenZFSConfiguration
openZFSConfiguration
      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 UpdateFileSystemWindowsConfiguration
windowsConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fileSystemId

instance Data.ToHeaders UpdateFileSystem where
  toHeaders :: UpdateFileSystem -> 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.UpdateFileSystem" ::
                          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 UpdateFileSystem where
  toJSON :: UpdateFileSystem -> Value
toJSON UpdateFileSystem' {Maybe Natural
Maybe Text
Maybe UpdateFileSystemLustreConfiguration
Maybe UpdateFileSystemOntapConfiguration
Maybe UpdateFileSystemOpenZFSConfiguration
Maybe UpdateFileSystemWindowsConfiguration
Text
fileSystemId :: Text
windowsConfiguration :: Maybe UpdateFileSystemWindowsConfiguration
storageCapacity :: Maybe Natural
openZFSConfiguration :: Maybe UpdateFileSystemOpenZFSConfiguration
ontapConfiguration :: Maybe UpdateFileSystemOntapConfiguration
lustreConfiguration :: Maybe UpdateFileSystemLustreConfiguration
clientRequestToken :: Maybe Text
$sel:fileSystemId:UpdateFileSystem' :: UpdateFileSystem -> Text
$sel:windowsConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemWindowsConfiguration
$sel:storageCapacity:UpdateFileSystem' :: UpdateFileSystem -> Maybe Natural
$sel:openZFSConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemOpenZFSConfiguration
$sel:ontapConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemOntapConfiguration
$sel:lustreConfiguration:UpdateFileSystem' :: UpdateFileSystem -> Maybe UpdateFileSystemLustreConfiguration
$sel:clientRequestToken:UpdateFileSystem' :: UpdateFileSystem -> 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
"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 UpdateFileSystemLustreConfiguration
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 UpdateFileSystemOntapConfiguration
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 UpdateFileSystemOpenZFSConfiguration
openZFSConfiguration,
            (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
"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 UpdateFileSystemWindowsConfiguration
windowsConfiguration,
            forall a. a -> Maybe a
Prelude.Just (Key
"FileSystemId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
fileSystemId)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateFileSystemResponse' 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', 'updateFileSystemResponse_fileSystem' - A description of the file system that was updated.
--
-- 'httpStatus', 'updateFileSystemResponse_httpStatus' - The response's http status code.
newUpdateFileSystemResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateFileSystemResponse
newUpdateFileSystemResponse :: Int -> UpdateFileSystemResponse
newUpdateFileSystemResponse Int
pHttpStatus_ =
  UpdateFileSystemResponse'
    { $sel:fileSystem:UpdateFileSystemResponse' :: Maybe FileSystem
fileSystem =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateFileSystemResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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