{-# 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.EFS.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)
--
-- Updates the throughput mode or the amount of provisioned throughput of
-- an existing file system.
module Amazonka.EFS.UpdateFileSystem
  ( -- * Creating a Request
    UpdateFileSystem (..),
    newUpdateFileSystem,

    -- * Request Lenses
    updateFileSystem_provisionedThroughputInMibps,
    updateFileSystem_throughputMode,
    updateFileSystem_fileSystemId,

    -- * Destructuring the Response
    FileSystemDescription (..),
    newFileSystemDescription,

    -- * Response Lenses
    fileSystemDescription_availabilityZoneId,
    fileSystemDescription_availabilityZoneName,
    fileSystemDescription_encrypted,
    fileSystemDescription_fileSystemArn,
    fileSystemDescription_kmsKeyId,
    fileSystemDescription_name,
    fileSystemDescription_provisionedThroughputInMibps,
    fileSystemDescription_throughputMode,
    fileSystemDescription_ownerId,
    fileSystemDescription_creationToken,
    fileSystemDescription_fileSystemId,
    fileSystemDescription_creationTime,
    fileSystemDescription_lifeCycleState,
    fileSystemDescription_numberOfMountTargets,
    fileSystemDescription_sizeInBytes,
    fileSystemDescription_performanceMode,
    fileSystemDescription_tags,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EFS.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateFileSystem' smart constructor.
data UpdateFileSystem = UpdateFileSystem'
  { -- | (Optional) Sets the amount of provisioned throughput, in MiB\/s, for the
    -- file system. Valid values are 1-1024. If you are changing the throughput
    -- mode to provisioned, you must also provide the amount of provisioned
    -- throughput. Required if @ThroughputMode@ is changed to @provisioned@ on
    -- update.
    UpdateFileSystem -> Maybe Double
provisionedThroughputInMibps :: Prelude.Maybe Prelude.Double,
    -- | (Optional) Updates the file system\'s throughput mode. If you\'re not
    -- updating your throughput mode, you don\'t need to provide this value in
    -- your request. If you are changing the @ThroughputMode@ to @provisioned@,
    -- you must also set a value for @ProvisionedThroughputInMibps@.
    UpdateFileSystem -> Maybe ThroughputMode
throughputMode :: Prelude.Maybe ThroughputMode,
    -- | The ID of the file system that you want to update.
    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, ReadPrec [UpdateFileSystem]
ReadPrec UpdateFileSystem
Int -> ReadS UpdateFileSystem
ReadS [UpdateFileSystem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFileSystem]
$creadListPrec :: ReadPrec [UpdateFileSystem]
readPrec :: ReadPrec UpdateFileSystem
$creadPrec :: ReadPrec UpdateFileSystem
readList :: ReadS [UpdateFileSystem]
$creadList :: ReadS [UpdateFileSystem]
readsPrec :: Int -> ReadS UpdateFileSystem
$creadsPrec :: Int -> ReadS UpdateFileSystem
Prelude.Read, 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:
--
-- 'provisionedThroughputInMibps', 'updateFileSystem_provisionedThroughputInMibps' - (Optional) Sets the amount of provisioned throughput, in MiB\/s, for the
-- file system. Valid values are 1-1024. If you are changing the throughput
-- mode to provisioned, you must also provide the amount of provisioned
-- throughput. Required if @ThroughputMode@ is changed to @provisioned@ on
-- update.
--
-- 'throughputMode', 'updateFileSystem_throughputMode' - (Optional) Updates the file system\'s throughput mode. If you\'re not
-- updating your throughput mode, you don\'t need to provide this value in
-- your request. If you are changing the @ThroughputMode@ to @provisioned@,
-- you must also set a value for @ProvisionedThroughputInMibps@.
--
-- 'fileSystemId', 'updateFileSystem_fileSystemId' - The ID of the file system that you want to update.
newUpdateFileSystem ::
  -- | 'fileSystemId'
  Prelude.Text ->
  UpdateFileSystem
newUpdateFileSystem :: Text -> UpdateFileSystem
newUpdateFileSystem Text
pFileSystemId_ =
  UpdateFileSystem'
    { $sel:provisionedThroughputInMibps:UpdateFileSystem' :: Maybe Double
provisionedThroughputInMibps =
        forall a. Maybe a
Prelude.Nothing,
      $sel:throughputMode:UpdateFileSystem' :: Maybe ThroughputMode
throughputMode = forall a. Maybe a
Prelude.Nothing,
      $sel:fileSystemId:UpdateFileSystem' :: Text
fileSystemId = Text
pFileSystemId_
    }

-- | (Optional) Sets the amount of provisioned throughput, in MiB\/s, for the
-- file system. Valid values are 1-1024. If you are changing the throughput
-- mode to provisioned, you must also provide the amount of provisioned
-- throughput. Required if @ThroughputMode@ is changed to @provisioned@ on
-- update.
updateFileSystem_provisionedThroughputInMibps :: Lens.Lens' UpdateFileSystem (Prelude.Maybe Prelude.Double)
updateFileSystem_provisionedThroughputInMibps :: Lens' UpdateFileSystem (Maybe Double)
updateFileSystem_provisionedThroughputInMibps = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFileSystem' {Maybe Double
provisionedThroughputInMibps :: Maybe Double
$sel:provisionedThroughputInMibps:UpdateFileSystem' :: UpdateFileSystem -> Maybe Double
provisionedThroughputInMibps} -> Maybe Double
provisionedThroughputInMibps) (\s :: UpdateFileSystem
s@UpdateFileSystem' {} Maybe Double
a -> UpdateFileSystem
s {$sel:provisionedThroughputInMibps:UpdateFileSystem' :: Maybe Double
provisionedThroughputInMibps = Maybe Double
a} :: UpdateFileSystem)

-- | (Optional) Updates the file system\'s throughput mode. If you\'re not
-- updating your throughput mode, you don\'t need to provide this value in
-- your request. If you are changing the @ThroughputMode@ to @provisioned@,
-- you must also set a value for @ProvisionedThroughputInMibps@.
updateFileSystem_throughputMode :: Lens.Lens' UpdateFileSystem (Prelude.Maybe ThroughputMode)
updateFileSystem_throughputMode :: Lens' UpdateFileSystem (Maybe ThroughputMode)
updateFileSystem_throughputMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFileSystem' {Maybe ThroughputMode
throughputMode :: Maybe ThroughputMode
$sel:throughputMode:UpdateFileSystem' :: UpdateFileSystem -> Maybe ThroughputMode
throughputMode} -> Maybe ThroughputMode
throughputMode) (\s :: UpdateFileSystem
s@UpdateFileSystem' {} Maybe ThroughputMode
a -> UpdateFileSystem
s {$sel:throughputMode:UpdateFileSystem' :: Maybe ThroughputMode
throughputMode = Maybe ThroughputMode
a} :: UpdateFileSystem)

-- | The ID of the file system that you want to update.
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 =
      FileSystemDescription
  request :: (Service -> Service)
-> UpdateFileSystem -> Request UpdateFileSystem
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable UpdateFileSystem where
  hashWithSalt :: Int -> UpdateFileSystem -> Int
hashWithSalt Int
_salt UpdateFileSystem' {Maybe Double
Maybe ThroughputMode
Text
fileSystemId :: Text
throughputMode :: Maybe ThroughputMode
provisionedThroughputInMibps :: Maybe Double
$sel:fileSystemId:UpdateFileSystem' :: UpdateFileSystem -> Text
$sel:throughputMode:UpdateFileSystem' :: UpdateFileSystem -> Maybe ThroughputMode
$sel:provisionedThroughputInMibps:UpdateFileSystem' :: UpdateFileSystem -> Maybe Double
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
provisionedThroughputInMibps
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ThroughputMode
throughputMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fileSystemId

instance Prelude.NFData UpdateFileSystem where
  rnf :: UpdateFileSystem -> ()
rnf UpdateFileSystem' {Maybe Double
Maybe ThroughputMode
Text
fileSystemId :: Text
throughputMode :: Maybe ThroughputMode
provisionedThroughputInMibps :: Maybe Double
$sel:fileSystemId:UpdateFileSystem' :: UpdateFileSystem -> Text
$sel:throughputMode:UpdateFileSystem' :: UpdateFileSystem -> Maybe ThroughputMode
$sel:provisionedThroughputInMibps:UpdateFileSystem' :: UpdateFileSystem -> Maybe Double
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
provisionedThroughputInMibps
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ThroughputMode
throughputMode
      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
Prelude.mempty

instance Data.ToJSON UpdateFileSystem where
  toJSON :: UpdateFileSystem -> Value
toJSON UpdateFileSystem' {Maybe Double
Maybe ThroughputMode
Text
fileSystemId :: Text
throughputMode :: Maybe ThroughputMode
provisionedThroughputInMibps :: Maybe Double
$sel:fileSystemId:UpdateFileSystem' :: UpdateFileSystem -> Text
$sel:throughputMode:UpdateFileSystem' :: UpdateFileSystem -> Maybe ThroughputMode
$sel:provisionedThroughputInMibps:UpdateFileSystem' :: UpdateFileSystem -> Maybe Double
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ProvisionedThroughputInMibps" 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 Double
provisionedThroughputInMibps,
            (Key
"ThroughputMode" 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 ThroughputMode
throughputMode
          ]
      )

instance Data.ToPath UpdateFileSystem where
  toPath :: UpdateFileSystem -> ByteString
toPath UpdateFileSystem' {Maybe Double
Maybe ThroughputMode
Text
fileSystemId :: Text
throughputMode :: Maybe ThroughputMode
provisionedThroughputInMibps :: Maybe Double
$sel:fileSystemId:UpdateFileSystem' :: UpdateFileSystem -> Text
$sel:throughputMode:UpdateFileSystem' :: UpdateFileSystem -> Maybe ThroughputMode
$sel:provisionedThroughputInMibps:UpdateFileSystem' :: UpdateFileSystem -> Maybe Double
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/2015-02-01/file-systems/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
fileSystemId]

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