{-# 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.CreateFileCache
-- 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 File Cache resource.
--
-- You can use this operation with a client request token in the request
-- that Amazon File Cache uses to ensure idempotent creation. If a cache
-- with the specified client request token exists and the parameters match,
-- @CreateFileCache@ returns the description of the existing cache. If a
-- cache with the specified client request token exists and the parameters
-- don\'t match, this call returns @IncompatibleParameterError@. If a file
-- cache with the specified client request token doesn\'t exist,
-- @CreateFileCache@ does the following:
--
-- -   Creates a new, empty Amazon File Cache resourcewith an assigned ID,
--     and an initial lifecycle state of @CREATING@.
--
-- -   Returns the description of the cache in JSON format.
--
-- The @CreateFileCache@ call returns while the cache\'s lifecycle state is
-- still @CREATING@. You can check the cache creation status by calling the
-- <https://docs.aws.amazon.com/fsx/latest/APIReference/API_DescribeFileCaches.html DescribeFileCaches>
-- operation, which returns the cache state along with other information.
module Amazonka.FSx.CreateFileCache
  ( -- * Creating a Request
    CreateFileCache (..),
    newCreateFileCache,

    -- * Request Lenses
    createFileCache_clientRequestToken,
    createFileCache_copyTagsToDataRepositoryAssociations,
    createFileCache_dataRepositoryAssociations,
    createFileCache_kmsKeyId,
    createFileCache_lustreConfiguration,
    createFileCache_securityGroupIds,
    createFileCache_tags,
    createFileCache_fileCacheType,
    createFileCache_fileCacheTypeVersion,
    createFileCache_storageCapacity,
    createFileCache_subnetIds,

    -- * Destructuring the Response
    CreateFileCacheResponse (..),
    newCreateFileCacheResponse,

    -- * Response Lenses
    createFileCacheResponse_fileCache,
    createFileCacheResponse_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:/ 'newCreateFileCache' smart constructor.
data CreateFileCache = CreateFileCache'
  { -- | An idempotency token for resource creation, in a string of up to 64
    -- ASCII characters. This token is automatically filled on your behalf when
    -- you use the Command Line Interface (CLI) or an Amazon Web Services SDK.
    --
    -- By using the idempotent operation, you can retry a @CreateFileCache@
    -- operation without the risk of creating an extra cache. This approach can
    -- be useful when an initial call fails in a way that makes it unclear
    -- whether a cache 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 cache, the client receives
    -- success as long as the parameters are the same.
    CreateFileCache -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | A boolean flag indicating whether tags for the cache should be copied to
    -- data repository associations. This value defaults to false.
    CreateFileCache -> Maybe Bool
copyTagsToDataRepositoryAssociations :: Prelude.Maybe Prelude.Bool,
    -- | A list of up to 8 configurations for data repository associations (DRAs)
    -- to be created during the cache creation. The DRAs link the cache to
    -- either an Amazon S3 data repository or a Network File System (NFS) data
    -- repository that supports the NFSv3 protocol.
    --
    -- The DRA configurations must meet the following requirements:
    --
    -- -   All configurations on the list must be of the same data repository
    --     type, either all S3 or all NFS. A cache can\'t link to different
    --     data repository types at the same time.
    --
    -- -   An NFS DRA must link to an NFS file system that supports the NFSv3
    --     protocol.
    --
    -- DRA automatic import and automatic export is not supported.
    CreateFileCache -> Maybe [FileCacheDataRepositoryAssociation]
dataRepositoryAssociations :: Prelude.Maybe [FileCacheDataRepositoryAssociation],
    -- | Specifies the ID of the Key Management Service (KMS) key to use for
    -- encrypting data on an Amazon File Cache. If a @KmsKeyId@ isn\'t
    -- specified, the Amazon FSx-managed KMS key for your account is used. For
    -- more information, see
    -- <https://docs.aws.amazon.com/kms/latest/APIReference/API_Encrypt.html Encrypt>
    -- in the /Key Management Service API Reference/.
    CreateFileCache -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The configuration for the Amazon File Cache resource being created.
    CreateFileCache -> Maybe CreateFileCacheLustreConfiguration
lustreConfiguration :: Prelude.Maybe CreateFileCacheLustreConfiguration,
    -- | A list of IDs specifying the security groups to apply to all network
    -- interfaces created for Amazon File Cache access. This list isn\'t
    -- returned in later requests to describe the cache.
    CreateFileCache -> Maybe [Text]
securityGroupIds :: Prelude.Maybe [Prelude.Text],
    CreateFileCache -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The type of cache that you\'re creating, which must be @LUSTRE@.
    CreateFileCache -> FileCacheType
fileCacheType :: FileCacheType,
    -- | Sets the Lustre version for the cache that you\'re creating, which must
    -- be @2.12@.
    CreateFileCache -> Text
fileCacheTypeVersion :: Prelude.Text,
    -- | The storage capacity of the cache in gibibytes (GiB). Valid values are
    -- 1200 GiB, 2400 GiB, and increments of 2400 GiB.
    CreateFileCache -> Natural
storageCapacity :: Prelude.Natural,
    CreateFileCache -> [Text]
subnetIds :: [Prelude.Text]
  }
  deriving (CreateFileCache -> CreateFileCache -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFileCache -> CreateFileCache -> Bool
$c/= :: CreateFileCache -> CreateFileCache -> Bool
== :: CreateFileCache -> CreateFileCache -> Bool
$c== :: CreateFileCache -> CreateFileCache -> Bool
Prelude.Eq, ReadPrec [CreateFileCache]
ReadPrec CreateFileCache
Int -> ReadS CreateFileCache
ReadS [CreateFileCache]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFileCache]
$creadListPrec :: ReadPrec [CreateFileCache]
readPrec :: ReadPrec CreateFileCache
$creadPrec :: ReadPrec CreateFileCache
readList :: ReadS [CreateFileCache]
$creadList :: ReadS [CreateFileCache]
readsPrec :: Int -> ReadS CreateFileCache
$creadsPrec :: Int -> ReadS CreateFileCache
Prelude.Read, Int -> CreateFileCache -> ShowS
[CreateFileCache] -> ShowS
CreateFileCache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFileCache] -> ShowS
$cshowList :: [CreateFileCache] -> ShowS
show :: CreateFileCache -> String
$cshow :: CreateFileCache -> String
showsPrec :: Int -> CreateFileCache -> ShowS
$cshowsPrec :: Int -> CreateFileCache -> ShowS
Prelude.Show, forall x. Rep CreateFileCache x -> CreateFileCache
forall x. CreateFileCache -> Rep CreateFileCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFileCache x -> CreateFileCache
$cfrom :: forall x. CreateFileCache -> Rep CreateFileCache x
Prelude.Generic)

-- |
-- Create a value of 'CreateFileCache' 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', 'createFileCache_clientRequestToken' - An idempotency token for resource creation, in a string of up to 64
-- ASCII characters. This token is automatically filled on your behalf when
-- you use the Command Line Interface (CLI) or an Amazon Web Services SDK.
--
-- By using the idempotent operation, you can retry a @CreateFileCache@
-- operation without the risk of creating an extra cache. This approach can
-- be useful when an initial call fails in a way that makes it unclear
-- whether a cache 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 cache, the client receives
-- success as long as the parameters are the same.
--
-- 'copyTagsToDataRepositoryAssociations', 'createFileCache_copyTagsToDataRepositoryAssociations' - A boolean flag indicating whether tags for the cache should be copied to
-- data repository associations. This value defaults to false.
--
-- 'dataRepositoryAssociations', 'createFileCache_dataRepositoryAssociations' - A list of up to 8 configurations for data repository associations (DRAs)
-- to be created during the cache creation. The DRAs link the cache to
-- either an Amazon S3 data repository or a Network File System (NFS) data
-- repository that supports the NFSv3 protocol.
--
-- The DRA configurations must meet the following requirements:
--
-- -   All configurations on the list must be of the same data repository
--     type, either all S3 or all NFS. A cache can\'t link to different
--     data repository types at the same time.
--
-- -   An NFS DRA must link to an NFS file system that supports the NFSv3
--     protocol.
--
-- DRA automatic import and automatic export is not supported.
--
-- 'kmsKeyId', 'createFileCache_kmsKeyId' - Specifies the ID of the Key Management Service (KMS) key to use for
-- encrypting data on an Amazon File Cache. If a @KmsKeyId@ isn\'t
-- specified, the Amazon FSx-managed KMS key for your account is used. For
-- more information, see
-- <https://docs.aws.amazon.com/kms/latest/APIReference/API_Encrypt.html Encrypt>
-- in the /Key Management Service API Reference/.
--
-- 'lustreConfiguration', 'createFileCache_lustreConfiguration' - The configuration for the Amazon File Cache resource being created.
--
-- 'securityGroupIds', 'createFileCache_securityGroupIds' - A list of IDs specifying the security groups to apply to all network
-- interfaces created for Amazon File Cache access. This list isn\'t
-- returned in later requests to describe the cache.
--
-- 'tags', 'createFileCache_tags' - Undocumented member.
--
-- 'fileCacheType', 'createFileCache_fileCacheType' - The type of cache that you\'re creating, which must be @LUSTRE@.
--
-- 'fileCacheTypeVersion', 'createFileCache_fileCacheTypeVersion' - Sets the Lustre version for the cache that you\'re creating, which must
-- be @2.12@.
--
-- 'storageCapacity', 'createFileCache_storageCapacity' - The storage capacity of the cache in gibibytes (GiB). Valid values are
-- 1200 GiB, 2400 GiB, and increments of 2400 GiB.
--
-- 'subnetIds', 'createFileCache_subnetIds' - Undocumented member.
newCreateFileCache ::
  -- | 'fileCacheType'
  FileCacheType ->
  -- | 'fileCacheTypeVersion'
  Prelude.Text ->
  -- | 'storageCapacity'
  Prelude.Natural ->
  CreateFileCache
newCreateFileCache :: FileCacheType -> Text -> Natural -> CreateFileCache
newCreateFileCache
  FileCacheType
pFileCacheType_
  Text
pFileCacheTypeVersion_
  Natural
pStorageCapacity_ =
    CreateFileCache'
      { $sel:clientRequestToken:CreateFileCache' :: Maybe Text
clientRequestToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:copyTagsToDataRepositoryAssociations:CreateFileCache' :: Maybe Bool
copyTagsToDataRepositoryAssociations =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dataRepositoryAssociations:CreateFileCache' :: Maybe [FileCacheDataRepositoryAssociation]
dataRepositoryAssociations = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:CreateFileCache' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:lustreConfiguration:CreateFileCache' :: Maybe CreateFileCacheLustreConfiguration
lustreConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:securityGroupIds:CreateFileCache' :: Maybe [Text]
securityGroupIds = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateFileCache' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:fileCacheType:CreateFileCache' :: FileCacheType
fileCacheType = FileCacheType
pFileCacheType_,
        $sel:fileCacheTypeVersion:CreateFileCache' :: Text
fileCacheTypeVersion = Text
pFileCacheTypeVersion_,
        $sel:storageCapacity:CreateFileCache' :: Natural
storageCapacity = Natural
pStorageCapacity_,
        $sel:subnetIds:CreateFileCache' :: [Text]
subnetIds = forall a. Monoid a => a
Prelude.mempty
      }

-- | An idempotency token for resource creation, in a string of up to 64
-- ASCII characters. This token is automatically filled on your behalf when
-- you use the Command Line Interface (CLI) or an Amazon Web Services SDK.
--
-- By using the idempotent operation, you can retry a @CreateFileCache@
-- operation without the risk of creating an extra cache. This approach can
-- be useful when an initial call fails in a way that makes it unclear
-- whether a cache 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 cache, the client receives
-- success as long as the parameters are the same.
createFileCache_clientRequestToken :: Lens.Lens' CreateFileCache (Prelude.Maybe Prelude.Text)
createFileCache_clientRequestToken :: Lens' CreateFileCache (Maybe Text)
createFileCache_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileCache' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreateFileCache' :: CreateFileCache -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreateFileCache
s@CreateFileCache' {} Maybe Text
a -> CreateFileCache
s {$sel:clientRequestToken:CreateFileCache' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreateFileCache)

-- | A boolean flag indicating whether tags for the cache should be copied to
-- data repository associations. This value defaults to false.
createFileCache_copyTagsToDataRepositoryAssociations :: Lens.Lens' CreateFileCache (Prelude.Maybe Prelude.Bool)
createFileCache_copyTagsToDataRepositoryAssociations :: Lens' CreateFileCache (Maybe Bool)
createFileCache_copyTagsToDataRepositoryAssociations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileCache' {Maybe Bool
copyTagsToDataRepositoryAssociations :: Maybe Bool
$sel:copyTagsToDataRepositoryAssociations:CreateFileCache' :: CreateFileCache -> Maybe Bool
copyTagsToDataRepositoryAssociations} -> Maybe Bool
copyTagsToDataRepositoryAssociations) (\s :: CreateFileCache
s@CreateFileCache' {} Maybe Bool
a -> CreateFileCache
s {$sel:copyTagsToDataRepositoryAssociations:CreateFileCache' :: Maybe Bool
copyTagsToDataRepositoryAssociations = Maybe Bool
a} :: CreateFileCache)

-- | A list of up to 8 configurations for data repository associations (DRAs)
-- to be created during the cache creation. The DRAs link the cache to
-- either an Amazon S3 data repository or a Network File System (NFS) data
-- repository that supports the NFSv3 protocol.
--
-- The DRA configurations must meet the following requirements:
--
-- -   All configurations on the list must be of the same data repository
--     type, either all S3 or all NFS. A cache can\'t link to different
--     data repository types at the same time.
--
-- -   An NFS DRA must link to an NFS file system that supports the NFSv3
--     protocol.
--
-- DRA automatic import and automatic export is not supported.
createFileCache_dataRepositoryAssociations :: Lens.Lens' CreateFileCache (Prelude.Maybe [FileCacheDataRepositoryAssociation])
createFileCache_dataRepositoryAssociations :: Lens' CreateFileCache (Maybe [FileCacheDataRepositoryAssociation])
createFileCache_dataRepositoryAssociations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileCache' {Maybe [FileCacheDataRepositoryAssociation]
dataRepositoryAssociations :: Maybe [FileCacheDataRepositoryAssociation]
$sel:dataRepositoryAssociations:CreateFileCache' :: CreateFileCache -> Maybe [FileCacheDataRepositoryAssociation]
dataRepositoryAssociations} -> Maybe [FileCacheDataRepositoryAssociation]
dataRepositoryAssociations) (\s :: CreateFileCache
s@CreateFileCache' {} Maybe [FileCacheDataRepositoryAssociation]
a -> CreateFileCache
s {$sel:dataRepositoryAssociations:CreateFileCache' :: Maybe [FileCacheDataRepositoryAssociation]
dataRepositoryAssociations = Maybe [FileCacheDataRepositoryAssociation]
a} :: CreateFileCache) 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

-- | Specifies the ID of the Key Management Service (KMS) key to use for
-- encrypting data on an Amazon File Cache. If a @KmsKeyId@ isn\'t
-- specified, the Amazon FSx-managed KMS key for your account is used. For
-- more information, see
-- <https://docs.aws.amazon.com/kms/latest/APIReference/API_Encrypt.html Encrypt>
-- in the /Key Management Service API Reference/.
createFileCache_kmsKeyId :: Lens.Lens' CreateFileCache (Prelude.Maybe Prelude.Text)
createFileCache_kmsKeyId :: Lens' CreateFileCache (Maybe Text)
createFileCache_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileCache' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:CreateFileCache' :: CreateFileCache -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: CreateFileCache
s@CreateFileCache' {} Maybe Text
a -> CreateFileCache
s {$sel:kmsKeyId:CreateFileCache' :: Maybe Text
kmsKeyId = Maybe Text
a} :: CreateFileCache)

-- | The configuration for the Amazon File Cache resource being created.
createFileCache_lustreConfiguration :: Lens.Lens' CreateFileCache (Prelude.Maybe CreateFileCacheLustreConfiguration)
createFileCache_lustreConfiguration :: Lens' CreateFileCache (Maybe CreateFileCacheLustreConfiguration)
createFileCache_lustreConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileCache' {Maybe CreateFileCacheLustreConfiguration
lustreConfiguration :: Maybe CreateFileCacheLustreConfiguration
$sel:lustreConfiguration:CreateFileCache' :: CreateFileCache -> Maybe CreateFileCacheLustreConfiguration
lustreConfiguration} -> Maybe CreateFileCacheLustreConfiguration
lustreConfiguration) (\s :: CreateFileCache
s@CreateFileCache' {} Maybe CreateFileCacheLustreConfiguration
a -> CreateFileCache
s {$sel:lustreConfiguration:CreateFileCache' :: Maybe CreateFileCacheLustreConfiguration
lustreConfiguration = Maybe CreateFileCacheLustreConfiguration
a} :: CreateFileCache)

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

-- | Undocumented member.
createFileCache_tags :: Lens.Lens' CreateFileCache (Prelude.Maybe (Prelude.NonEmpty Tag))
createFileCache_tags :: Lens' CreateFileCache (Maybe (NonEmpty Tag))
createFileCache_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileCache' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateFileCache' :: CreateFileCache -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateFileCache
s@CreateFileCache' {} Maybe (NonEmpty Tag)
a -> CreateFileCache
s {$sel:tags:CreateFileCache' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateFileCache) 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 type of cache that you\'re creating, which must be @LUSTRE@.
createFileCache_fileCacheType :: Lens.Lens' CreateFileCache FileCacheType
createFileCache_fileCacheType :: Lens' CreateFileCache FileCacheType
createFileCache_fileCacheType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileCache' {FileCacheType
fileCacheType :: FileCacheType
$sel:fileCacheType:CreateFileCache' :: CreateFileCache -> FileCacheType
fileCacheType} -> FileCacheType
fileCacheType) (\s :: CreateFileCache
s@CreateFileCache' {} FileCacheType
a -> CreateFileCache
s {$sel:fileCacheType:CreateFileCache' :: FileCacheType
fileCacheType = FileCacheType
a} :: CreateFileCache)

-- | Sets the Lustre version for the cache that you\'re creating, which must
-- be @2.12@.
createFileCache_fileCacheTypeVersion :: Lens.Lens' CreateFileCache Prelude.Text
createFileCache_fileCacheTypeVersion :: Lens' CreateFileCache Text
createFileCache_fileCacheTypeVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileCache' {Text
fileCacheTypeVersion :: Text
$sel:fileCacheTypeVersion:CreateFileCache' :: CreateFileCache -> Text
fileCacheTypeVersion} -> Text
fileCacheTypeVersion) (\s :: CreateFileCache
s@CreateFileCache' {} Text
a -> CreateFileCache
s {$sel:fileCacheTypeVersion:CreateFileCache' :: Text
fileCacheTypeVersion = Text
a} :: CreateFileCache)

-- | The storage capacity of the cache in gibibytes (GiB). Valid values are
-- 1200 GiB, 2400 GiB, and increments of 2400 GiB.
createFileCache_storageCapacity :: Lens.Lens' CreateFileCache Prelude.Natural
createFileCache_storageCapacity :: Lens' CreateFileCache Natural
createFileCache_storageCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileCache' {Natural
storageCapacity :: Natural
$sel:storageCapacity:CreateFileCache' :: CreateFileCache -> Natural
storageCapacity} -> Natural
storageCapacity) (\s :: CreateFileCache
s@CreateFileCache' {} Natural
a -> CreateFileCache
s {$sel:storageCapacity:CreateFileCache' :: Natural
storageCapacity = Natural
a} :: CreateFileCache)

-- | Undocumented member.
createFileCache_subnetIds :: Lens.Lens' CreateFileCache [Prelude.Text]
createFileCache_subnetIds :: Lens' CreateFileCache [Text]
createFileCache_subnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFileCache' {[Text]
subnetIds :: [Text]
$sel:subnetIds:CreateFileCache' :: CreateFileCache -> [Text]
subnetIds} -> [Text]
subnetIds) (\s :: CreateFileCache
s@CreateFileCache' {} [Text]
a -> CreateFileCache
s {$sel:subnetIds:CreateFileCache' :: [Text]
subnetIds = [Text]
a} :: CreateFileCache) 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 CreateFileCache where
  type
    AWSResponse CreateFileCache =
      CreateFileCacheResponse
  request :: (Service -> Service) -> CreateFileCache -> Request CreateFileCache
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 CreateFileCache
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateFileCache)))
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 FileCacheCreating -> Int -> CreateFileCacheResponse
CreateFileCacheResponse'
            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 CreateFileCache where
  hashWithSalt :: Int -> CreateFileCache -> Int
hashWithSalt Int
_salt CreateFileCache' {Natural
[Text]
Maybe Bool
Maybe [Text]
Maybe [FileCacheDataRepositoryAssociation]
Maybe (NonEmpty Tag)
Maybe Text
Maybe CreateFileCacheLustreConfiguration
Text
FileCacheType
subnetIds :: [Text]
storageCapacity :: Natural
fileCacheTypeVersion :: Text
fileCacheType :: FileCacheType
tags :: Maybe (NonEmpty Tag)
securityGroupIds :: Maybe [Text]
lustreConfiguration :: Maybe CreateFileCacheLustreConfiguration
kmsKeyId :: Maybe Text
dataRepositoryAssociations :: Maybe [FileCacheDataRepositoryAssociation]
copyTagsToDataRepositoryAssociations :: Maybe Bool
clientRequestToken :: Maybe Text
$sel:subnetIds:CreateFileCache' :: CreateFileCache -> [Text]
$sel:storageCapacity:CreateFileCache' :: CreateFileCache -> Natural
$sel:fileCacheTypeVersion:CreateFileCache' :: CreateFileCache -> Text
$sel:fileCacheType:CreateFileCache' :: CreateFileCache -> FileCacheType
$sel:tags:CreateFileCache' :: CreateFileCache -> Maybe (NonEmpty Tag)
$sel:securityGroupIds:CreateFileCache' :: CreateFileCache -> Maybe [Text]
$sel:lustreConfiguration:CreateFileCache' :: CreateFileCache -> Maybe CreateFileCacheLustreConfiguration
$sel:kmsKeyId:CreateFileCache' :: CreateFileCache -> Maybe Text
$sel:dataRepositoryAssociations:CreateFileCache' :: CreateFileCache -> Maybe [FileCacheDataRepositoryAssociation]
$sel:copyTagsToDataRepositoryAssociations:CreateFileCache' :: CreateFileCache -> Maybe Bool
$sel:clientRequestToken:CreateFileCache' :: CreateFileCache -> 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 Bool
copyTagsToDataRepositoryAssociations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [FileCacheDataRepositoryAssociation]
dataRepositoryAssociations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CreateFileCacheLustreConfiguration
lustreConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FileCacheType
fileCacheType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fileCacheTypeVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
storageCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
subnetIds

instance Prelude.NFData CreateFileCache where
  rnf :: CreateFileCache -> ()
rnf CreateFileCache' {Natural
[Text]
Maybe Bool
Maybe [Text]
Maybe [FileCacheDataRepositoryAssociation]
Maybe (NonEmpty Tag)
Maybe Text
Maybe CreateFileCacheLustreConfiguration
Text
FileCacheType
subnetIds :: [Text]
storageCapacity :: Natural
fileCacheTypeVersion :: Text
fileCacheType :: FileCacheType
tags :: Maybe (NonEmpty Tag)
securityGroupIds :: Maybe [Text]
lustreConfiguration :: Maybe CreateFileCacheLustreConfiguration
kmsKeyId :: Maybe Text
dataRepositoryAssociations :: Maybe [FileCacheDataRepositoryAssociation]
copyTagsToDataRepositoryAssociations :: Maybe Bool
clientRequestToken :: Maybe Text
$sel:subnetIds:CreateFileCache' :: CreateFileCache -> [Text]
$sel:storageCapacity:CreateFileCache' :: CreateFileCache -> Natural
$sel:fileCacheTypeVersion:CreateFileCache' :: CreateFileCache -> Text
$sel:fileCacheType:CreateFileCache' :: CreateFileCache -> FileCacheType
$sel:tags:CreateFileCache' :: CreateFileCache -> Maybe (NonEmpty Tag)
$sel:securityGroupIds:CreateFileCache' :: CreateFileCache -> Maybe [Text]
$sel:lustreConfiguration:CreateFileCache' :: CreateFileCache -> Maybe CreateFileCacheLustreConfiguration
$sel:kmsKeyId:CreateFileCache' :: CreateFileCache -> Maybe Text
$sel:dataRepositoryAssociations:CreateFileCache' :: CreateFileCache -> Maybe [FileCacheDataRepositoryAssociation]
$sel:copyTagsToDataRepositoryAssociations:CreateFileCache' :: CreateFileCache -> Maybe Bool
$sel:clientRequestToken:CreateFileCache' :: CreateFileCache -> 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 Bool
copyTagsToDataRepositoryAssociations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [FileCacheDataRepositoryAssociation]
dataRepositoryAssociations
      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 CreateFileCacheLustreConfiguration
lustreConfiguration
      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 (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FileCacheType
fileCacheType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fileCacheTypeVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
storageCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
subnetIds

instance Data.ToHeaders CreateFileCache where
  toHeaders :: CreateFileCache -> 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.CreateFileCache" ::
                          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 CreateFileCache where
  toJSON :: CreateFileCache -> Value
toJSON CreateFileCache' {Natural
[Text]
Maybe Bool
Maybe [Text]
Maybe [FileCacheDataRepositoryAssociation]
Maybe (NonEmpty Tag)
Maybe Text
Maybe CreateFileCacheLustreConfiguration
Text
FileCacheType
subnetIds :: [Text]
storageCapacity :: Natural
fileCacheTypeVersion :: Text
fileCacheType :: FileCacheType
tags :: Maybe (NonEmpty Tag)
securityGroupIds :: Maybe [Text]
lustreConfiguration :: Maybe CreateFileCacheLustreConfiguration
kmsKeyId :: Maybe Text
dataRepositoryAssociations :: Maybe [FileCacheDataRepositoryAssociation]
copyTagsToDataRepositoryAssociations :: Maybe Bool
clientRequestToken :: Maybe Text
$sel:subnetIds:CreateFileCache' :: CreateFileCache -> [Text]
$sel:storageCapacity:CreateFileCache' :: CreateFileCache -> Natural
$sel:fileCacheTypeVersion:CreateFileCache' :: CreateFileCache -> Text
$sel:fileCacheType:CreateFileCache' :: CreateFileCache -> FileCacheType
$sel:tags:CreateFileCache' :: CreateFileCache -> Maybe (NonEmpty Tag)
$sel:securityGroupIds:CreateFileCache' :: CreateFileCache -> Maybe [Text]
$sel:lustreConfiguration:CreateFileCache' :: CreateFileCache -> Maybe CreateFileCacheLustreConfiguration
$sel:kmsKeyId:CreateFileCache' :: CreateFileCache -> Maybe Text
$sel:dataRepositoryAssociations:CreateFileCache' :: CreateFileCache -> Maybe [FileCacheDataRepositoryAssociation]
$sel:copyTagsToDataRepositoryAssociations:CreateFileCache' :: CreateFileCache -> Maybe Bool
$sel:clientRequestToken:CreateFileCache' :: CreateFileCache -> 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
"CopyTagsToDataRepositoryAssociations" 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 Bool
copyTagsToDataRepositoryAssociations,
            (Key
"DataRepositoryAssociations" 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 [FileCacheDataRepositoryAssociation]
dataRepositoryAssociations,
            (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 CreateFileCacheLustreConfiguration
lustreConfiguration,
            (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
"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,
            forall a. a -> Maybe a
Prelude.Just (Key
"FileCacheType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= FileCacheType
fileCacheType),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"FileCacheTypeVersion"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
fileCacheTypeVersion
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"StorageCapacity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
storageCapacity),
            forall a. a -> Maybe a
Prelude.Just (Key
"SubnetIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
subnetIds)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateFileCacheResponse' 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', 'createFileCacheResponse_fileCache' - A description of the cache that was created.
--
-- 'httpStatus', 'createFileCacheResponse_httpStatus' - The response's http status code.
newCreateFileCacheResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateFileCacheResponse
newCreateFileCacheResponse :: Int -> CreateFileCacheResponse
newCreateFileCacheResponse Int
pHttpStatus_ =
  CreateFileCacheResponse'
    { $sel:fileCache:CreateFileCacheResponse' :: Maybe FileCacheCreating
fileCache =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateFileCacheResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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