{-# 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.UpdateFileCache
-- 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 configuration of an existing Amazon File Cache resource. You
-- can update multiple properties in a single request.
module Amazonka.FSx.UpdateFileCache
  ( -- * Creating a Request
    UpdateFileCache (..),
    newUpdateFileCache,

    -- * Request Lenses
    updateFileCache_clientRequestToken,
    updateFileCache_lustreConfiguration,
    updateFileCache_fileCacheId,

    -- * Destructuring the Response
    UpdateFileCacheResponse (..),
    newUpdateFileCacheResponse,

    -- * Response Lenses
    updateFileCacheResponse_fileCache,
    updateFileCacheResponse_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

-- | /See:/ 'newUpdateFileCache' smart constructor.
data UpdateFileCache = UpdateFileCache'
  { UpdateFileCache -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The configuration updates for an Amazon File Cache resource.
    UpdateFileCache -> Maybe UpdateFileCacheLustreConfiguration
lustreConfiguration :: Prelude.Maybe UpdateFileCacheLustreConfiguration,
    -- | The ID of the cache that you are updating.
    UpdateFileCache -> Text
fileCacheId :: Prelude.Text
  }
  deriving (UpdateFileCache -> UpdateFileCache -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFileCache -> UpdateFileCache -> Bool
$c/= :: UpdateFileCache -> UpdateFileCache -> Bool
== :: UpdateFileCache -> UpdateFileCache -> Bool
$c== :: UpdateFileCache -> UpdateFileCache -> Bool
Prelude.Eq, ReadPrec [UpdateFileCache]
ReadPrec UpdateFileCache
Int -> ReadS UpdateFileCache
ReadS [UpdateFileCache]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFileCache]
$creadListPrec :: ReadPrec [UpdateFileCache]
readPrec :: ReadPrec UpdateFileCache
$creadPrec :: ReadPrec UpdateFileCache
readList :: ReadS [UpdateFileCache]
$creadList :: ReadS [UpdateFileCache]
readsPrec :: Int -> ReadS UpdateFileCache
$creadsPrec :: Int -> ReadS UpdateFileCache
Prelude.Read, Int -> UpdateFileCache -> ShowS
[UpdateFileCache] -> ShowS
UpdateFileCache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFileCache] -> ShowS
$cshowList :: [UpdateFileCache] -> ShowS
show :: UpdateFileCache -> String
$cshow :: UpdateFileCache -> String
showsPrec :: Int -> UpdateFileCache -> ShowS
$cshowsPrec :: Int -> UpdateFileCache -> ShowS
Prelude.Show, forall x. Rep UpdateFileCache x -> UpdateFileCache
forall x. UpdateFileCache -> Rep UpdateFileCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFileCache x -> UpdateFileCache
$cfrom :: forall x. UpdateFileCache -> Rep UpdateFileCache x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFileCache' 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', 'updateFileCache_clientRequestToken' - Undocumented member.
--
-- 'lustreConfiguration', 'updateFileCache_lustreConfiguration' - The configuration updates for an Amazon File Cache resource.
--
-- 'fileCacheId', 'updateFileCache_fileCacheId' - The ID of the cache that you are updating.
newUpdateFileCache ::
  -- | 'fileCacheId'
  Prelude.Text ->
  UpdateFileCache
newUpdateFileCache :: Text -> UpdateFileCache
newUpdateFileCache Text
pFileCacheId_ =
  UpdateFileCache'
    { $sel:clientRequestToken:UpdateFileCache' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:lustreConfiguration:UpdateFileCache' :: Maybe UpdateFileCacheLustreConfiguration
lustreConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:fileCacheId:UpdateFileCache' :: Text
fileCacheId = Text
pFileCacheId_
    }

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

-- | The configuration updates for an Amazon File Cache resource.
updateFileCache_lustreConfiguration :: Lens.Lens' UpdateFileCache (Prelude.Maybe UpdateFileCacheLustreConfiguration)
updateFileCache_lustreConfiguration :: Lens' UpdateFileCache (Maybe UpdateFileCacheLustreConfiguration)
updateFileCache_lustreConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFileCache' {Maybe UpdateFileCacheLustreConfiguration
lustreConfiguration :: Maybe UpdateFileCacheLustreConfiguration
$sel:lustreConfiguration:UpdateFileCache' :: UpdateFileCache -> Maybe UpdateFileCacheLustreConfiguration
lustreConfiguration} -> Maybe UpdateFileCacheLustreConfiguration
lustreConfiguration) (\s :: UpdateFileCache
s@UpdateFileCache' {} Maybe UpdateFileCacheLustreConfiguration
a -> UpdateFileCache
s {$sel:lustreConfiguration:UpdateFileCache' :: Maybe UpdateFileCacheLustreConfiguration
lustreConfiguration = Maybe UpdateFileCacheLustreConfiguration
a} :: UpdateFileCache)

-- | The ID of the cache that you are updating.
updateFileCache_fileCacheId :: Lens.Lens' UpdateFileCache Prelude.Text
updateFileCache_fileCacheId :: Lens' UpdateFileCache Text
updateFileCache_fileCacheId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFileCache' {Text
fileCacheId :: Text
$sel:fileCacheId:UpdateFileCache' :: UpdateFileCache -> Text
fileCacheId} -> Text
fileCacheId) (\s :: UpdateFileCache
s@UpdateFileCache' {} Text
a -> UpdateFileCache
s {$sel:fileCacheId:UpdateFileCache' :: Text
fileCacheId = Text
a} :: UpdateFileCache)

instance Core.AWSRequest UpdateFileCache where
  type
    AWSResponse UpdateFileCache =
      UpdateFileCacheResponse
  request :: (Service -> Service) -> UpdateFileCache -> Request UpdateFileCache
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 UpdateFileCache
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateFileCache)))
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 FileCache -> Int -> UpdateFileCacheResponse
UpdateFileCacheResponse'
            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
"FileCache")
            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 UpdateFileCache where
  hashWithSalt :: Int -> UpdateFileCache -> Int
hashWithSalt Int
_salt UpdateFileCache' {Maybe Text
Maybe UpdateFileCacheLustreConfiguration
Text
fileCacheId :: Text
lustreConfiguration :: Maybe UpdateFileCacheLustreConfiguration
clientRequestToken :: Maybe Text
$sel:fileCacheId:UpdateFileCache' :: UpdateFileCache -> Text
$sel:lustreConfiguration:UpdateFileCache' :: UpdateFileCache -> Maybe UpdateFileCacheLustreConfiguration
$sel:clientRequestToken:UpdateFileCache' :: UpdateFileCache -> 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 UpdateFileCacheLustreConfiguration
lustreConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fileCacheId

instance Prelude.NFData UpdateFileCache where
  rnf :: UpdateFileCache -> ()
rnf UpdateFileCache' {Maybe Text
Maybe UpdateFileCacheLustreConfiguration
Text
fileCacheId :: Text
lustreConfiguration :: Maybe UpdateFileCacheLustreConfiguration
clientRequestToken :: Maybe Text
$sel:fileCacheId:UpdateFileCache' :: UpdateFileCache -> Text
$sel:lustreConfiguration:UpdateFileCache' :: UpdateFileCache -> Maybe UpdateFileCacheLustreConfiguration
$sel:clientRequestToken:UpdateFileCache' :: UpdateFileCache -> 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 UpdateFileCacheLustreConfiguration
lustreConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fileCacheId

instance Data.ToHeaders UpdateFileCache where
  toHeaders :: UpdateFileCache -> 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.UpdateFileCache" ::
                          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 UpdateFileCache where
  toJSON :: UpdateFileCache -> Value
toJSON UpdateFileCache' {Maybe Text
Maybe UpdateFileCacheLustreConfiguration
Text
fileCacheId :: Text
lustreConfiguration :: Maybe UpdateFileCacheLustreConfiguration
clientRequestToken :: Maybe Text
$sel:fileCacheId:UpdateFileCache' :: UpdateFileCache -> Text
$sel:lustreConfiguration:UpdateFileCache' :: UpdateFileCache -> Maybe UpdateFileCacheLustreConfiguration
$sel:clientRequestToken:UpdateFileCache' :: UpdateFileCache -> 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 UpdateFileCacheLustreConfiguration
lustreConfiguration,
            forall a. a -> Maybe a
Prelude.Just (Key
"FileCacheId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
fileCacheId)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateFileCacheResponse' 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:
--
-- 'fileCache', 'updateFileCacheResponse_fileCache' - A description of the cache that was updated.
--
-- 'httpStatus', 'updateFileCacheResponse_httpStatus' - The response's http status code.
newUpdateFileCacheResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateFileCacheResponse
newUpdateFileCacheResponse :: Int -> UpdateFileCacheResponse
newUpdateFileCacheResponse Int
pHttpStatus_ =
  UpdateFileCacheResponse'
    { $sel:fileCache:UpdateFileCacheResponse' :: Maybe FileCache
fileCache =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateFileCacheResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A description of the cache that was updated.
updateFileCacheResponse_fileCache :: Lens.Lens' UpdateFileCacheResponse (Prelude.Maybe FileCache)
updateFileCacheResponse_fileCache :: Lens' UpdateFileCacheResponse (Maybe FileCache)
updateFileCacheResponse_fileCache = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFileCacheResponse' {Maybe FileCache
fileCache :: Maybe FileCache
$sel:fileCache:UpdateFileCacheResponse' :: UpdateFileCacheResponse -> Maybe FileCache
fileCache} -> Maybe FileCache
fileCache) (\s :: UpdateFileCacheResponse
s@UpdateFileCacheResponse' {} Maybe FileCache
a -> UpdateFileCacheResponse
s {$sel:fileCache:UpdateFileCacheResponse' :: Maybe FileCache
fileCache = Maybe FileCache
a} :: UpdateFileCacheResponse)

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

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