{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.FileCacheDataRepositoryAssociation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.FSx.Types.FileCacheDataRepositoryAssociation 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.FileCacheNFSConfiguration
import qualified Amazonka.Prelude as Prelude

-- | The configuration for a data repository association (DRA) to be created
-- during the Amazon File Cache resource creation. The DRA links the cache
-- to either an Amazon S3 bucket or prefix, or a Network File System (NFS)
-- data repository that supports the NFSv3 protocol.
--
-- The DRA does not support automatic import or automatic export.
--
-- /See:/ 'newFileCacheDataRepositoryAssociation' smart constructor.
data FileCacheDataRepositoryAssociation = FileCacheDataRepositoryAssociation'
  { -- | A list of NFS Exports that will be linked with this data repository
    -- association. The Export paths are in the format @\/exportpath1@. To use
    -- this parameter, you must configure @DataRepositoryPath@ as the domain
    -- name of the NFS file system. The NFS file system domain name in effect
    -- is the root of the subdirectories. Note that
    -- @DataRepositorySubdirectories@ is not supported for S3 data
    -- repositories.
    FileCacheDataRepositoryAssociation -> Maybe [Text]
dataRepositorySubdirectories :: Prelude.Maybe [Prelude.Text],
    -- | The configuration for a data repository association that links an Amazon
    -- File Cache resource to an NFS data repository.
    FileCacheDataRepositoryAssociation
-> Maybe FileCacheNFSConfiguration
nfs :: Prelude.Maybe FileCacheNFSConfiguration,
    -- | A path on the cache that points to a high-level directory (such as
    -- @\/ns1\/@) or subdirectory (such as @\/ns1\/subdir\/@) that will be
    -- mapped 1-1 with @DataRepositoryPath@. The leading forward slash in the
    -- name is required. Two data repository associations cannot have
    -- overlapping cache paths. For example, if a data repository is associated
    -- with cache path @\/ns1\/@, then you cannot link another data repository
    -- with cache path @\/ns1\/ns2@.
    --
    -- This path specifies where in your cache files will be exported from.
    -- This cache directory can be linked to only one data repository, and no
    -- data repository other can be linked to the directory.
    --
    -- The cache path can only be set to root (\/) on an NFS DRA when
    -- @DataRepositorySubdirectories@ is specified. If you specify root (\/) as
    -- the cache path, you can create only one DRA on the cache.
    --
    -- The cache path cannot be set to root (\/) for an S3 DRA.
    FileCacheDataRepositoryAssociation -> Text
fileCachePath :: Prelude.Text,
    -- | The path to the S3 or NFS data repository that links to the cache. You
    -- must provide one of the following paths:
    --
    -- -   The path can be an NFS data repository that links to the cache. The
    --     path can be in one of two formats:
    --
    --     -   If you are not using the @DataRepositorySubdirectories@
    --         parameter, the path is to an NFS Export directory (or one of its
    --         subdirectories) in the format
    --         @nsf:\/\/nfs-domain-name\/exportpath@. You can therefore link a
    --         single NFS Export to a single data repository association.
    --
    --     -   If you are using the @DataRepositorySubdirectories@ parameter,
    --         the path is the domain name of the NFS file system in the format
    --         @nfs:\/\/filer-domain-name@, which indicates the root of the
    --         subdirectories specified with the @DataRepositorySubdirectories@
    --         parameter.
    --
    -- -   The path can be an S3 bucket or prefix in the format
    --     @s3:\/\/myBucket\/myPrefix\/@.
    FileCacheDataRepositoryAssociation -> Text
dataRepositoryPath :: Prelude.Text
  }
  deriving (FileCacheDataRepositoryAssociation
-> FileCacheDataRepositoryAssociation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileCacheDataRepositoryAssociation
-> FileCacheDataRepositoryAssociation -> Bool
$c/= :: FileCacheDataRepositoryAssociation
-> FileCacheDataRepositoryAssociation -> Bool
== :: FileCacheDataRepositoryAssociation
-> FileCacheDataRepositoryAssociation -> Bool
$c== :: FileCacheDataRepositoryAssociation
-> FileCacheDataRepositoryAssociation -> Bool
Prelude.Eq, ReadPrec [FileCacheDataRepositoryAssociation]
ReadPrec FileCacheDataRepositoryAssociation
Int -> ReadS FileCacheDataRepositoryAssociation
ReadS [FileCacheDataRepositoryAssociation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileCacheDataRepositoryAssociation]
$creadListPrec :: ReadPrec [FileCacheDataRepositoryAssociation]
readPrec :: ReadPrec FileCacheDataRepositoryAssociation
$creadPrec :: ReadPrec FileCacheDataRepositoryAssociation
readList :: ReadS [FileCacheDataRepositoryAssociation]
$creadList :: ReadS [FileCacheDataRepositoryAssociation]
readsPrec :: Int -> ReadS FileCacheDataRepositoryAssociation
$creadsPrec :: Int -> ReadS FileCacheDataRepositoryAssociation
Prelude.Read, Int -> FileCacheDataRepositoryAssociation -> ShowS
[FileCacheDataRepositoryAssociation] -> ShowS
FileCacheDataRepositoryAssociation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileCacheDataRepositoryAssociation] -> ShowS
$cshowList :: [FileCacheDataRepositoryAssociation] -> ShowS
show :: FileCacheDataRepositoryAssociation -> String
$cshow :: FileCacheDataRepositoryAssociation -> String
showsPrec :: Int -> FileCacheDataRepositoryAssociation -> ShowS
$cshowsPrec :: Int -> FileCacheDataRepositoryAssociation -> ShowS
Prelude.Show, forall x.
Rep FileCacheDataRepositoryAssociation x
-> FileCacheDataRepositoryAssociation
forall x.
FileCacheDataRepositoryAssociation
-> Rep FileCacheDataRepositoryAssociation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep FileCacheDataRepositoryAssociation x
-> FileCacheDataRepositoryAssociation
$cfrom :: forall x.
FileCacheDataRepositoryAssociation
-> Rep FileCacheDataRepositoryAssociation x
Prelude.Generic)

-- |
-- Create a value of 'FileCacheDataRepositoryAssociation' 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:
--
-- 'dataRepositorySubdirectories', 'fileCacheDataRepositoryAssociation_dataRepositorySubdirectories' - A list of NFS Exports that will be linked with this data repository
-- association. The Export paths are in the format @\/exportpath1@. To use
-- this parameter, you must configure @DataRepositoryPath@ as the domain
-- name of the NFS file system. The NFS file system domain name in effect
-- is the root of the subdirectories. Note that
-- @DataRepositorySubdirectories@ is not supported for S3 data
-- repositories.
--
-- 'nfs', 'fileCacheDataRepositoryAssociation_nfs' - The configuration for a data repository association that links an Amazon
-- File Cache resource to an NFS data repository.
--
-- 'fileCachePath', 'fileCacheDataRepositoryAssociation_fileCachePath' - A path on the cache that points to a high-level directory (such as
-- @\/ns1\/@) or subdirectory (such as @\/ns1\/subdir\/@) that will be
-- mapped 1-1 with @DataRepositoryPath@. The leading forward slash in the
-- name is required. Two data repository associations cannot have
-- overlapping cache paths. For example, if a data repository is associated
-- with cache path @\/ns1\/@, then you cannot link another data repository
-- with cache path @\/ns1\/ns2@.
--
-- This path specifies where in your cache files will be exported from.
-- This cache directory can be linked to only one data repository, and no
-- data repository other can be linked to the directory.
--
-- The cache path can only be set to root (\/) on an NFS DRA when
-- @DataRepositorySubdirectories@ is specified. If you specify root (\/) as
-- the cache path, you can create only one DRA on the cache.
--
-- The cache path cannot be set to root (\/) for an S3 DRA.
--
-- 'dataRepositoryPath', 'fileCacheDataRepositoryAssociation_dataRepositoryPath' - The path to the S3 or NFS data repository that links to the cache. You
-- must provide one of the following paths:
--
-- -   The path can be an NFS data repository that links to the cache. The
--     path can be in one of two formats:
--
--     -   If you are not using the @DataRepositorySubdirectories@
--         parameter, the path is to an NFS Export directory (or one of its
--         subdirectories) in the format
--         @nsf:\/\/nfs-domain-name\/exportpath@. You can therefore link a
--         single NFS Export to a single data repository association.
--
--     -   If you are using the @DataRepositorySubdirectories@ parameter,
--         the path is the domain name of the NFS file system in the format
--         @nfs:\/\/filer-domain-name@, which indicates the root of the
--         subdirectories specified with the @DataRepositorySubdirectories@
--         parameter.
--
-- -   The path can be an S3 bucket or prefix in the format
--     @s3:\/\/myBucket\/myPrefix\/@.
newFileCacheDataRepositoryAssociation ::
  -- | 'fileCachePath'
  Prelude.Text ->
  -- | 'dataRepositoryPath'
  Prelude.Text ->
  FileCacheDataRepositoryAssociation
newFileCacheDataRepositoryAssociation :: Text -> Text -> FileCacheDataRepositoryAssociation
newFileCacheDataRepositoryAssociation
  Text
pFileCachePath_
  Text
pDataRepositoryPath_ =
    FileCacheDataRepositoryAssociation'
      { $sel:dataRepositorySubdirectories:FileCacheDataRepositoryAssociation' :: Maybe [Text]
dataRepositorySubdirectories =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nfs:FileCacheDataRepositoryAssociation' :: Maybe FileCacheNFSConfiguration
nfs = forall a. Maybe a
Prelude.Nothing,
        $sel:fileCachePath:FileCacheDataRepositoryAssociation' :: Text
fileCachePath = Text
pFileCachePath_,
        $sel:dataRepositoryPath:FileCacheDataRepositoryAssociation' :: Text
dataRepositoryPath =
          Text
pDataRepositoryPath_
      }

-- | A list of NFS Exports that will be linked with this data repository
-- association. The Export paths are in the format @\/exportpath1@. To use
-- this parameter, you must configure @DataRepositoryPath@ as the domain
-- name of the NFS file system. The NFS file system domain name in effect
-- is the root of the subdirectories. Note that
-- @DataRepositorySubdirectories@ is not supported for S3 data
-- repositories.
fileCacheDataRepositoryAssociation_dataRepositorySubdirectories :: Lens.Lens' FileCacheDataRepositoryAssociation (Prelude.Maybe [Prelude.Text])
fileCacheDataRepositoryAssociation_dataRepositorySubdirectories :: Lens' FileCacheDataRepositoryAssociation (Maybe [Text])
fileCacheDataRepositoryAssociation_dataRepositorySubdirectories = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FileCacheDataRepositoryAssociation' {Maybe [Text]
dataRepositorySubdirectories :: Maybe [Text]
$sel:dataRepositorySubdirectories:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation -> Maybe [Text]
dataRepositorySubdirectories} -> Maybe [Text]
dataRepositorySubdirectories) (\s :: FileCacheDataRepositoryAssociation
s@FileCacheDataRepositoryAssociation' {} Maybe [Text]
a -> FileCacheDataRepositoryAssociation
s {$sel:dataRepositorySubdirectories:FileCacheDataRepositoryAssociation' :: Maybe [Text]
dataRepositorySubdirectories = Maybe [Text]
a} :: FileCacheDataRepositoryAssociation) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The configuration for a data repository association that links an Amazon
-- File Cache resource to an NFS data repository.
fileCacheDataRepositoryAssociation_nfs :: Lens.Lens' FileCacheDataRepositoryAssociation (Prelude.Maybe FileCacheNFSConfiguration)
fileCacheDataRepositoryAssociation_nfs :: Lens'
  FileCacheDataRepositoryAssociation
  (Maybe FileCacheNFSConfiguration)
fileCacheDataRepositoryAssociation_nfs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FileCacheDataRepositoryAssociation' {Maybe FileCacheNFSConfiguration
nfs :: Maybe FileCacheNFSConfiguration
$sel:nfs:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation
-> Maybe FileCacheNFSConfiguration
nfs} -> Maybe FileCacheNFSConfiguration
nfs) (\s :: FileCacheDataRepositoryAssociation
s@FileCacheDataRepositoryAssociation' {} Maybe FileCacheNFSConfiguration
a -> FileCacheDataRepositoryAssociation
s {$sel:nfs:FileCacheDataRepositoryAssociation' :: Maybe FileCacheNFSConfiguration
nfs = Maybe FileCacheNFSConfiguration
a} :: FileCacheDataRepositoryAssociation)

-- | A path on the cache that points to a high-level directory (such as
-- @\/ns1\/@) or subdirectory (such as @\/ns1\/subdir\/@) that will be
-- mapped 1-1 with @DataRepositoryPath@. The leading forward slash in the
-- name is required. Two data repository associations cannot have
-- overlapping cache paths. For example, if a data repository is associated
-- with cache path @\/ns1\/@, then you cannot link another data repository
-- with cache path @\/ns1\/ns2@.
--
-- This path specifies where in your cache files will be exported from.
-- This cache directory can be linked to only one data repository, and no
-- data repository other can be linked to the directory.
--
-- The cache path can only be set to root (\/) on an NFS DRA when
-- @DataRepositorySubdirectories@ is specified. If you specify root (\/) as
-- the cache path, you can create only one DRA on the cache.
--
-- The cache path cannot be set to root (\/) for an S3 DRA.
fileCacheDataRepositoryAssociation_fileCachePath :: Lens.Lens' FileCacheDataRepositoryAssociation Prelude.Text
fileCacheDataRepositoryAssociation_fileCachePath :: Lens' FileCacheDataRepositoryAssociation Text
fileCacheDataRepositoryAssociation_fileCachePath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FileCacheDataRepositoryAssociation' {Text
fileCachePath :: Text
$sel:fileCachePath:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation -> Text
fileCachePath} -> Text
fileCachePath) (\s :: FileCacheDataRepositoryAssociation
s@FileCacheDataRepositoryAssociation' {} Text
a -> FileCacheDataRepositoryAssociation
s {$sel:fileCachePath:FileCacheDataRepositoryAssociation' :: Text
fileCachePath = Text
a} :: FileCacheDataRepositoryAssociation)

-- | The path to the S3 or NFS data repository that links to the cache. You
-- must provide one of the following paths:
--
-- -   The path can be an NFS data repository that links to the cache. The
--     path can be in one of two formats:
--
--     -   If you are not using the @DataRepositorySubdirectories@
--         parameter, the path is to an NFS Export directory (or one of its
--         subdirectories) in the format
--         @nsf:\/\/nfs-domain-name\/exportpath@. You can therefore link a
--         single NFS Export to a single data repository association.
--
--     -   If you are using the @DataRepositorySubdirectories@ parameter,
--         the path is the domain name of the NFS file system in the format
--         @nfs:\/\/filer-domain-name@, which indicates the root of the
--         subdirectories specified with the @DataRepositorySubdirectories@
--         parameter.
--
-- -   The path can be an S3 bucket or prefix in the format
--     @s3:\/\/myBucket\/myPrefix\/@.
fileCacheDataRepositoryAssociation_dataRepositoryPath :: Lens.Lens' FileCacheDataRepositoryAssociation Prelude.Text
fileCacheDataRepositoryAssociation_dataRepositoryPath :: Lens' FileCacheDataRepositoryAssociation Text
fileCacheDataRepositoryAssociation_dataRepositoryPath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FileCacheDataRepositoryAssociation' {Text
dataRepositoryPath :: Text
$sel:dataRepositoryPath:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation -> Text
dataRepositoryPath} -> Text
dataRepositoryPath) (\s :: FileCacheDataRepositoryAssociation
s@FileCacheDataRepositoryAssociation' {} Text
a -> FileCacheDataRepositoryAssociation
s {$sel:dataRepositoryPath:FileCacheDataRepositoryAssociation' :: Text
dataRepositoryPath = Text
a} :: FileCacheDataRepositoryAssociation)

instance
  Prelude.Hashable
    FileCacheDataRepositoryAssociation
  where
  hashWithSalt :: Int -> FileCacheDataRepositoryAssociation -> Int
hashWithSalt
    Int
_salt
    FileCacheDataRepositoryAssociation' {Maybe [Text]
Maybe FileCacheNFSConfiguration
Text
dataRepositoryPath :: Text
fileCachePath :: Text
nfs :: Maybe FileCacheNFSConfiguration
dataRepositorySubdirectories :: Maybe [Text]
$sel:dataRepositoryPath:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation -> Text
$sel:fileCachePath:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation -> Text
$sel:nfs:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation
-> Maybe FileCacheNFSConfiguration
$sel:dataRepositorySubdirectories:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation -> Maybe [Text]
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
dataRepositorySubdirectories
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FileCacheNFSConfiguration
nfs
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fileCachePath
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dataRepositoryPath

instance
  Prelude.NFData
    FileCacheDataRepositoryAssociation
  where
  rnf :: FileCacheDataRepositoryAssociation -> ()
rnf FileCacheDataRepositoryAssociation' {Maybe [Text]
Maybe FileCacheNFSConfiguration
Text
dataRepositoryPath :: Text
fileCachePath :: Text
nfs :: Maybe FileCacheNFSConfiguration
dataRepositorySubdirectories :: Maybe [Text]
$sel:dataRepositoryPath:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation -> Text
$sel:fileCachePath:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation -> Text
$sel:nfs:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation
-> Maybe FileCacheNFSConfiguration
$sel:dataRepositorySubdirectories:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
dataRepositorySubdirectories
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FileCacheNFSConfiguration
nfs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fileCachePath
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dataRepositoryPath

instance
  Data.ToJSON
    FileCacheDataRepositoryAssociation
  where
  toJSON :: FileCacheDataRepositoryAssociation -> Value
toJSON FileCacheDataRepositoryAssociation' {Maybe [Text]
Maybe FileCacheNFSConfiguration
Text
dataRepositoryPath :: Text
fileCachePath :: Text
nfs :: Maybe FileCacheNFSConfiguration
dataRepositorySubdirectories :: Maybe [Text]
$sel:dataRepositoryPath:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation -> Text
$sel:fileCachePath:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation -> Text
$sel:nfs:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation
-> Maybe FileCacheNFSConfiguration
$sel:dataRepositorySubdirectories:FileCacheDataRepositoryAssociation' :: FileCacheDataRepositoryAssociation -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DataRepositorySubdirectories" 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]
dataRepositorySubdirectories,
            (Key
"NFS" 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 FileCacheNFSConfiguration
nfs,
            forall a. a -> Maybe a
Prelude.Just (Key
"FileCachePath" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
fileCachePath),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DataRepositoryPath" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
dataRepositoryPath)
          ]
      )