{-# 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.CreateDataRepositoryAssociation
-- 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 an Amazon FSx for Lustre data repository association (DRA). A
-- data repository association is a link between a directory on the file
-- system and an Amazon S3 bucket or prefix. You can have a maximum of 8
-- data repository associations on a file system. Data repository
-- associations are supported only for file systems with the @Persistent_2@
-- deployment type.
--
-- Each data repository association must have a unique Amazon FSx file
-- system directory and a unique S3 bucket or prefix associated with it.
-- You can configure a data repository association for automatic import
-- only, for automatic export only, or for both. To learn more about
-- linking a data repository to your file system, see
-- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/create-dra-linked-data-repo.html Linking your file system to an S3 bucket>.
--
-- @CreateDataRepositoryAssociation@ isn\'t supported on Amazon File Cache
-- resources. To create a DRA on Amazon File Cache, use the
-- @CreateFileCache@ operation.
module Amazonka.FSx.CreateDataRepositoryAssociation
  ( -- * Creating a Request
    CreateDataRepositoryAssociation (..),
    newCreateDataRepositoryAssociation,

    -- * Request Lenses
    createDataRepositoryAssociation_batchImportMetaDataOnCreate,
    createDataRepositoryAssociation_clientRequestToken,
    createDataRepositoryAssociation_fileSystemPath,
    createDataRepositoryAssociation_importedFileChunkSize,
    createDataRepositoryAssociation_s3,
    createDataRepositoryAssociation_tags,
    createDataRepositoryAssociation_fileSystemId,
    createDataRepositoryAssociation_dataRepositoryPath,

    -- * Destructuring the Response
    CreateDataRepositoryAssociationResponse (..),
    newCreateDataRepositoryAssociationResponse,

    -- * Response Lenses
    createDataRepositoryAssociationResponse_association,
    createDataRepositoryAssociationResponse_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:/ 'newCreateDataRepositoryAssociation' smart constructor.
data CreateDataRepositoryAssociation = CreateDataRepositoryAssociation'
  { -- | Set to @true@ to run an import data repository task to import metadata
    -- from the data repository to the file system after the data repository
    -- association is created. Default is @false@.
    CreateDataRepositoryAssociation -> Maybe Bool
batchImportMetaDataOnCreate :: Prelude.Maybe Prelude.Bool,
    CreateDataRepositoryAssociation -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | A path on the file system 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 file system paths. For example, if a data repository is
    -- associated with file system path @\/ns1\/@, then you cannot link another
    -- data repository with file system path @\/ns1\/ns2@.
    --
    -- This path specifies where in your file system files will be exported
    -- from or imported to. This file system directory can be linked to only
    -- one Amazon S3 bucket, and no other S3 bucket can be linked to the
    -- directory.
    --
    -- If you specify only a forward slash (@\/@) as the file system path, you
    -- can link only one data repository to the file system. You can only
    -- specify \"\/\" as the file system path for the first data repository
    -- associated with a file system.
    CreateDataRepositoryAssociation -> Maybe Text
fileSystemPath :: Prelude.Maybe Prelude.Text,
    -- | For files imported from a data repository, this value determines the
    -- stripe count and maximum amount of data per file (in MiB) stored on a
    -- single physical disk. The maximum number of disks that a single file can
    -- be striped across is limited by the total number of disks that make up
    -- the file system.
    --
    -- The default chunk size is 1,024 MiB (1 GiB) and can go as high as
    -- 512,000 MiB (500 GiB). Amazon S3 objects have a maximum size of 5 TB.
    CreateDataRepositoryAssociation -> Maybe Natural
importedFileChunkSize :: Prelude.Maybe Prelude.Natural,
    -- | The configuration for an Amazon S3 data repository linked to an Amazon
    -- FSx Lustre file system with a data repository association. The
    -- configuration defines which file events (new, changed, or deleted files
    -- or directories) are automatically imported from the linked data
    -- repository to the file system or automatically exported from the file
    -- system to the data repository.
    CreateDataRepositoryAssociation
-> Maybe S3DataRepositoryConfiguration
s3 :: Prelude.Maybe S3DataRepositoryConfiguration,
    CreateDataRepositoryAssociation -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    CreateDataRepositoryAssociation -> Text
fileSystemId :: Prelude.Text,
    -- | The path to the Amazon S3 data repository that will be linked to the
    -- file system. The path can be an S3 bucket or prefix in the format
    -- @s3:\/\/myBucket\/myPrefix\/@. This path specifies where in the S3 data
    -- repository files will be imported from or exported to.
    CreateDataRepositoryAssociation -> Text
dataRepositoryPath :: Prelude.Text
  }
  deriving (CreateDataRepositoryAssociation
-> CreateDataRepositoryAssociation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDataRepositoryAssociation
-> CreateDataRepositoryAssociation -> Bool
$c/= :: CreateDataRepositoryAssociation
-> CreateDataRepositoryAssociation -> Bool
== :: CreateDataRepositoryAssociation
-> CreateDataRepositoryAssociation -> Bool
$c== :: CreateDataRepositoryAssociation
-> CreateDataRepositoryAssociation -> Bool
Prelude.Eq, ReadPrec [CreateDataRepositoryAssociation]
ReadPrec CreateDataRepositoryAssociation
Int -> ReadS CreateDataRepositoryAssociation
ReadS [CreateDataRepositoryAssociation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDataRepositoryAssociation]
$creadListPrec :: ReadPrec [CreateDataRepositoryAssociation]
readPrec :: ReadPrec CreateDataRepositoryAssociation
$creadPrec :: ReadPrec CreateDataRepositoryAssociation
readList :: ReadS [CreateDataRepositoryAssociation]
$creadList :: ReadS [CreateDataRepositoryAssociation]
readsPrec :: Int -> ReadS CreateDataRepositoryAssociation
$creadsPrec :: Int -> ReadS CreateDataRepositoryAssociation
Prelude.Read, Int -> CreateDataRepositoryAssociation -> ShowS
[CreateDataRepositoryAssociation] -> ShowS
CreateDataRepositoryAssociation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDataRepositoryAssociation] -> ShowS
$cshowList :: [CreateDataRepositoryAssociation] -> ShowS
show :: CreateDataRepositoryAssociation -> String
$cshow :: CreateDataRepositoryAssociation -> String
showsPrec :: Int -> CreateDataRepositoryAssociation -> ShowS
$cshowsPrec :: Int -> CreateDataRepositoryAssociation -> ShowS
Prelude.Show, forall x.
Rep CreateDataRepositoryAssociation x
-> CreateDataRepositoryAssociation
forall x.
CreateDataRepositoryAssociation
-> Rep CreateDataRepositoryAssociation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDataRepositoryAssociation x
-> CreateDataRepositoryAssociation
$cfrom :: forall x.
CreateDataRepositoryAssociation
-> Rep CreateDataRepositoryAssociation x
Prelude.Generic)

-- |
-- Create a value of 'CreateDataRepositoryAssociation' 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:
--
-- 'batchImportMetaDataOnCreate', 'createDataRepositoryAssociation_batchImportMetaDataOnCreate' - Set to @true@ to run an import data repository task to import metadata
-- from the data repository to the file system after the data repository
-- association is created. Default is @false@.
--
-- 'clientRequestToken', 'createDataRepositoryAssociation_clientRequestToken' - Undocumented member.
--
-- 'fileSystemPath', 'createDataRepositoryAssociation_fileSystemPath' - A path on the file system 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 file system paths. For example, if a data repository is
-- associated with file system path @\/ns1\/@, then you cannot link another
-- data repository with file system path @\/ns1\/ns2@.
--
-- This path specifies where in your file system files will be exported
-- from or imported to. This file system directory can be linked to only
-- one Amazon S3 bucket, and no other S3 bucket can be linked to the
-- directory.
--
-- If you specify only a forward slash (@\/@) as the file system path, you
-- can link only one data repository to the file system. You can only
-- specify \"\/\" as the file system path for the first data repository
-- associated with a file system.
--
-- 'importedFileChunkSize', 'createDataRepositoryAssociation_importedFileChunkSize' - For files imported from a data repository, this value determines the
-- stripe count and maximum amount of data per file (in MiB) stored on a
-- single physical disk. The maximum number of disks that a single file can
-- be striped across is limited by the total number of disks that make up
-- the file system.
--
-- The default chunk size is 1,024 MiB (1 GiB) and can go as high as
-- 512,000 MiB (500 GiB). Amazon S3 objects have a maximum size of 5 TB.
--
-- 's3', 'createDataRepositoryAssociation_s3' - The configuration for an Amazon S3 data repository linked to an Amazon
-- FSx Lustre file system with a data repository association. The
-- configuration defines which file events (new, changed, or deleted files
-- or directories) are automatically imported from the linked data
-- repository to the file system or automatically exported from the file
-- system to the data repository.
--
-- 'tags', 'createDataRepositoryAssociation_tags' - Undocumented member.
--
-- 'fileSystemId', 'createDataRepositoryAssociation_fileSystemId' - Undocumented member.
--
-- 'dataRepositoryPath', 'createDataRepositoryAssociation_dataRepositoryPath' - The path to the Amazon S3 data repository that will be linked to the
-- file system. The path can be an S3 bucket or prefix in the format
-- @s3:\/\/myBucket\/myPrefix\/@. This path specifies where in the S3 data
-- repository files will be imported from or exported to.
newCreateDataRepositoryAssociation ::
  -- | 'fileSystemId'
  Prelude.Text ->
  -- | 'dataRepositoryPath'
  Prelude.Text ->
  CreateDataRepositoryAssociation
newCreateDataRepositoryAssociation :: Text -> Text -> CreateDataRepositoryAssociation
newCreateDataRepositoryAssociation
  Text
pFileSystemId_
  Text
pDataRepositoryPath_ =
    CreateDataRepositoryAssociation'
      { $sel:batchImportMetaDataOnCreate:CreateDataRepositoryAssociation' :: Maybe Bool
batchImportMetaDataOnCreate =
          forall a. Maybe a
Prelude.Nothing,
        $sel:clientRequestToken:CreateDataRepositoryAssociation' :: Maybe Text
clientRequestToken = forall a. Maybe a
Prelude.Nothing,
        $sel:fileSystemPath:CreateDataRepositoryAssociation' :: Maybe Text
fileSystemPath = forall a. Maybe a
Prelude.Nothing,
        $sel:importedFileChunkSize:CreateDataRepositoryAssociation' :: Maybe Natural
importedFileChunkSize = forall a. Maybe a
Prelude.Nothing,
        $sel:s3:CreateDataRepositoryAssociation' :: Maybe S3DataRepositoryConfiguration
s3 = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateDataRepositoryAssociation' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:fileSystemId:CreateDataRepositoryAssociation' :: Text
fileSystemId = Text
pFileSystemId_,
        $sel:dataRepositoryPath:CreateDataRepositoryAssociation' :: Text
dataRepositoryPath = Text
pDataRepositoryPath_
      }

-- | Set to @true@ to run an import data repository task to import metadata
-- from the data repository to the file system after the data repository
-- association is created. Default is @false@.
createDataRepositoryAssociation_batchImportMetaDataOnCreate :: Lens.Lens' CreateDataRepositoryAssociation (Prelude.Maybe Prelude.Bool)
createDataRepositoryAssociation_batchImportMetaDataOnCreate :: Lens' CreateDataRepositoryAssociation (Maybe Bool)
createDataRepositoryAssociation_batchImportMetaDataOnCreate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryAssociation' {Maybe Bool
batchImportMetaDataOnCreate :: Maybe Bool
$sel:batchImportMetaDataOnCreate:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Bool
batchImportMetaDataOnCreate} -> Maybe Bool
batchImportMetaDataOnCreate) (\s :: CreateDataRepositoryAssociation
s@CreateDataRepositoryAssociation' {} Maybe Bool
a -> CreateDataRepositoryAssociation
s {$sel:batchImportMetaDataOnCreate:CreateDataRepositoryAssociation' :: Maybe Bool
batchImportMetaDataOnCreate = Maybe Bool
a} :: CreateDataRepositoryAssociation)

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

-- | A path on the file system 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 file system paths. For example, if a data repository is
-- associated with file system path @\/ns1\/@, then you cannot link another
-- data repository with file system path @\/ns1\/ns2@.
--
-- This path specifies where in your file system files will be exported
-- from or imported to. This file system directory can be linked to only
-- one Amazon S3 bucket, and no other S3 bucket can be linked to the
-- directory.
--
-- If you specify only a forward slash (@\/@) as the file system path, you
-- can link only one data repository to the file system. You can only
-- specify \"\/\" as the file system path for the first data repository
-- associated with a file system.
createDataRepositoryAssociation_fileSystemPath :: Lens.Lens' CreateDataRepositoryAssociation (Prelude.Maybe Prelude.Text)
createDataRepositoryAssociation_fileSystemPath :: Lens' CreateDataRepositoryAssociation (Maybe Text)
createDataRepositoryAssociation_fileSystemPath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryAssociation' {Maybe Text
fileSystemPath :: Maybe Text
$sel:fileSystemPath:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Text
fileSystemPath} -> Maybe Text
fileSystemPath) (\s :: CreateDataRepositoryAssociation
s@CreateDataRepositoryAssociation' {} Maybe Text
a -> CreateDataRepositoryAssociation
s {$sel:fileSystemPath:CreateDataRepositoryAssociation' :: Maybe Text
fileSystemPath = Maybe Text
a} :: CreateDataRepositoryAssociation)

-- | For files imported from a data repository, this value determines the
-- stripe count and maximum amount of data per file (in MiB) stored on a
-- single physical disk. The maximum number of disks that a single file can
-- be striped across is limited by the total number of disks that make up
-- the file system.
--
-- The default chunk size is 1,024 MiB (1 GiB) and can go as high as
-- 512,000 MiB (500 GiB). Amazon S3 objects have a maximum size of 5 TB.
createDataRepositoryAssociation_importedFileChunkSize :: Lens.Lens' CreateDataRepositoryAssociation (Prelude.Maybe Prelude.Natural)
createDataRepositoryAssociation_importedFileChunkSize :: Lens' CreateDataRepositoryAssociation (Maybe Natural)
createDataRepositoryAssociation_importedFileChunkSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryAssociation' {Maybe Natural
importedFileChunkSize :: Maybe Natural
$sel:importedFileChunkSize:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Natural
importedFileChunkSize} -> Maybe Natural
importedFileChunkSize) (\s :: CreateDataRepositoryAssociation
s@CreateDataRepositoryAssociation' {} Maybe Natural
a -> CreateDataRepositoryAssociation
s {$sel:importedFileChunkSize:CreateDataRepositoryAssociation' :: Maybe Natural
importedFileChunkSize = Maybe Natural
a} :: CreateDataRepositoryAssociation)

-- | The configuration for an Amazon S3 data repository linked to an Amazon
-- FSx Lustre file system with a data repository association. The
-- configuration defines which file events (new, changed, or deleted files
-- or directories) are automatically imported from the linked data
-- repository to the file system or automatically exported from the file
-- system to the data repository.
createDataRepositoryAssociation_s3 :: Lens.Lens' CreateDataRepositoryAssociation (Prelude.Maybe S3DataRepositoryConfiguration)
createDataRepositoryAssociation_s3 :: Lens'
  CreateDataRepositoryAssociation
  (Maybe S3DataRepositoryConfiguration)
createDataRepositoryAssociation_s3 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryAssociation' {Maybe S3DataRepositoryConfiguration
s3 :: Maybe S3DataRepositoryConfiguration
$sel:s3:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation
-> Maybe S3DataRepositoryConfiguration
s3} -> Maybe S3DataRepositoryConfiguration
s3) (\s :: CreateDataRepositoryAssociation
s@CreateDataRepositoryAssociation' {} Maybe S3DataRepositoryConfiguration
a -> CreateDataRepositoryAssociation
s {$sel:s3:CreateDataRepositoryAssociation' :: Maybe S3DataRepositoryConfiguration
s3 = Maybe S3DataRepositoryConfiguration
a} :: CreateDataRepositoryAssociation)

-- | Undocumented member.
createDataRepositoryAssociation_tags :: Lens.Lens' CreateDataRepositoryAssociation (Prelude.Maybe (Prelude.NonEmpty Tag))
createDataRepositoryAssociation_tags :: Lens' CreateDataRepositoryAssociation (Maybe (NonEmpty Tag))
createDataRepositoryAssociation_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryAssociation' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateDataRepositoryAssociation
s@CreateDataRepositoryAssociation' {} Maybe (NonEmpty Tag)
a -> CreateDataRepositoryAssociation
s {$sel:tags:CreateDataRepositoryAssociation' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateDataRepositoryAssociation) 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.
createDataRepositoryAssociation_fileSystemId :: Lens.Lens' CreateDataRepositoryAssociation Prelude.Text
createDataRepositoryAssociation_fileSystemId :: Lens' CreateDataRepositoryAssociation Text
createDataRepositoryAssociation_fileSystemId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryAssociation' {Text
fileSystemId :: Text
$sel:fileSystemId:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Text
fileSystemId} -> Text
fileSystemId) (\s :: CreateDataRepositoryAssociation
s@CreateDataRepositoryAssociation' {} Text
a -> CreateDataRepositoryAssociation
s {$sel:fileSystemId:CreateDataRepositoryAssociation' :: Text
fileSystemId = Text
a} :: CreateDataRepositoryAssociation)

-- | The path to the Amazon S3 data repository that will be linked to the
-- file system. The path can be an S3 bucket or prefix in the format
-- @s3:\/\/myBucket\/myPrefix\/@. This path specifies where in the S3 data
-- repository files will be imported from or exported to.
createDataRepositoryAssociation_dataRepositoryPath :: Lens.Lens' CreateDataRepositoryAssociation Prelude.Text
createDataRepositoryAssociation_dataRepositoryPath :: Lens' CreateDataRepositoryAssociation Text
createDataRepositoryAssociation_dataRepositoryPath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryAssociation' {Text
dataRepositoryPath :: Text
$sel:dataRepositoryPath:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Text
dataRepositoryPath} -> Text
dataRepositoryPath) (\s :: CreateDataRepositoryAssociation
s@CreateDataRepositoryAssociation' {} Text
a -> CreateDataRepositoryAssociation
s {$sel:dataRepositoryPath:CreateDataRepositoryAssociation' :: Text
dataRepositoryPath = Text
a} :: CreateDataRepositoryAssociation)

instance
  Core.AWSRequest
    CreateDataRepositoryAssociation
  where
  type
    AWSResponse CreateDataRepositoryAssociation =
      CreateDataRepositoryAssociationResponse
  request :: (Service -> Service)
-> CreateDataRepositoryAssociation
-> Request CreateDataRepositoryAssociation
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 CreateDataRepositoryAssociation
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateDataRepositoryAssociation)))
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 DataRepositoryAssociation
-> Int -> CreateDataRepositoryAssociationResponse
CreateDataRepositoryAssociationResponse'
            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
"Association")
            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
    CreateDataRepositoryAssociation
  where
  hashWithSalt :: Int -> CreateDataRepositoryAssociation -> Int
hashWithSalt
    Int
_salt
    CreateDataRepositoryAssociation' {Maybe Bool
Maybe Natural
Maybe (NonEmpty Tag)
Maybe Text
Maybe S3DataRepositoryConfiguration
Text
dataRepositoryPath :: Text
fileSystemId :: Text
tags :: Maybe (NonEmpty Tag)
s3 :: Maybe S3DataRepositoryConfiguration
importedFileChunkSize :: Maybe Natural
fileSystemPath :: Maybe Text
clientRequestToken :: Maybe Text
batchImportMetaDataOnCreate :: Maybe Bool
$sel:dataRepositoryPath:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Text
$sel:fileSystemId:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Text
$sel:tags:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe (NonEmpty Tag)
$sel:s3:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation
-> Maybe S3DataRepositoryConfiguration
$sel:importedFileChunkSize:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Natural
$sel:fileSystemPath:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Text
$sel:clientRequestToken:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Text
$sel:batchImportMetaDataOnCreate:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Bool
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
batchImportMetaDataOnCreate
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
fileSystemPath
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
importedFileChunkSize
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe S3DataRepositoryConfiguration
s3
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fileSystemId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dataRepositoryPath

instance
  Prelude.NFData
    CreateDataRepositoryAssociation
  where
  rnf :: CreateDataRepositoryAssociation -> ()
rnf CreateDataRepositoryAssociation' {Maybe Bool
Maybe Natural
Maybe (NonEmpty Tag)
Maybe Text
Maybe S3DataRepositoryConfiguration
Text
dataRepositoryPath :: Text
fileSystemId :: Text
tags :: Maybe (NonEmpty Tag)
s3 :: Maybe S3DataRepositoryConfiguration
importedFileChunkSize :: Maybe Natural
fileSystemPath :: Maybe Text
clientRequestToken :: Maybe Text
batchImportMetaDataOnCreate :: Maybe Bool
$sel:dataRepositoryPath:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Text
$sel:fileSystemId:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Text
$sel:tags:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe (NonEmpty Tag)
$sel:s3:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation
-> Maybe S3DataRepositoryConfiguration
$sel:importedFileChunkSize:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Natural
$sel:fileSystemPath:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Text
$sel:clientRequestToken:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Text
$sel:batchImportMetaDataOnCreate:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
batchImportMetaDataOnCreate
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
fileSystemPath
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
importedFileChunkSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe S3DataRepositoryConfiguration
s3
      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 Text
fileSystemId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dataRepositoryPath

instance
  Data.ToHeaders
    CreateDataRepositoryAssociation
  where
  toHeaders :: CreateDataRepositoryAssociation -> 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.CreateDataRepositoryAssociation" ::
                          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 CreateDataRepositoryAssociation where
  toJSON :: CreateDataRepositoryAssociation -> Value
toJSON CreateDataRepositoryAssociation' {Maybe Bool
Maybe Natural
Maybe (NonEmpty Tag)
Maybe Text
Maybe S3DataRepositoryConfiguration
Text
dataRepositoryPath :: Text
fileSystemId :: Text
tags :: Maybe (NonEmpty Tag)
s3 :: Maybe S3DataRepositoryConfiguration
importedFileChunkSize :: Maybe Natural
fileSystemPath :: Maybe Text
clientRequestToken :: Maybe Text
batchImportMetaDataOnCreate :: Maybe Bool
$sel:dataRepositoryPath:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Text
$sel:fileSystemId:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Text
$sel:tags:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe (NonEmpty Tag)
$sel:s3:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation
-> Maybe S3DataRepositoryConfiguration
$sel:importedFileChunkSize:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Natural
$sel:fileSystemPath:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Text
$sel:clientRequestToken:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Text
$sel:batchImportMetaDataOnCreate:CreateDataRepositoryAssociation' :: CreateDataRepositoryAssociation -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BatchImportMetaDataOnCreate" 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
batchImportMetaDataOnCreate,
            (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
"FileSystemPath" 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
fileSystemPath,
            (Key
"ImportedFileChunkSize" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
importedFileChunkSize,
            (Key
"S3" 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 S3DataRepositoryConfiguration
s3,
            (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
"FileSystemId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
fileSystemId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DataRepositoryPath" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
dataRepositoryPath)
          ]
      )

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

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

-- | /See:/ 'newCreateDataRepositoryAssociationResponse' smart constructor.
data CreateDataRepositoryAssociationResponse = CreateDataRepositoryAssociationResponse'
  { -- | The response object returned after the data repository association is
    -- created.
    CreateDataRepositoryAssociationResponse
-> Maybe DataRepositoryAssociation
association :: Prelude.Maybe DataRepositoryAssociation,
    -- | The response's http status code.
    CreateDataRepositoryAssociationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDataRepositoryAssociationResponse
-> CreateDataRepositoryAssociationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDataRepositoryAssociationResponse
-> CreateDataRepositoryAssociationResponse -> Bool
$c/= :: CreateDataRepositoryAssociationResponse
-> CreateDataRepositoryAssociationResponse -> Bool
== :: CreateDataRepositoryAssociationResponse
-> CreateDataRepositoryAssociationResponse -> Bool
$c== :: CreateDataRepositoryAssociationResponse
-> CreateDataRepositoryAssociationResponse -> Bool
Prelude.Eq, ReadPrec [CreateDataRepositoryAssociationResponse]
ReadPrec CreateDataRepositoryAssociationResponse
Int -> ReadS CreateDataRepositoryAssociationResponse
ReadS [CreateDataRepositoryAssociationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDataRepositoryAssociationResponse]
$creadListPrec :: ReadPrec [CreateDataRepositoryAssociationResponse]
readPrec :: ReadPrec CreateDataRepositoryAssociationResponse
$creadPrec :: ReadPrec CreateDataRepositoryAssociationResponse
readList :: ReadS [CreateDataRepositoryAssociationResponse]
$creadList :: ReadS [CreateDataRepositoryAssociationResponse]
readsPrec :: Int -> ReadS CreateDataRepositoryAssociationResponse
$creadsPrec :: Int -> ReadS CreateDataRepositoryAssociationResponse
Prelude.Read, Int -> CreateDataRepositoryAssociationResponse -> ShowS
[CreateDataRepositoryAssociationResponse] -> ShowS
CreateDataRepositoryAssociationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDataRepositoryAssociationResponse] -> ShowS
$cshowList :: [CreateDataRepositoryAssociationResponse] -> ShowS
show :: CreateDataRepositoryAssociationResponse -> String
$cshow :: CreateDataRepositoryAssociationResponse -> String
showsPrec :: Int -> CreateDataRepositoryAssociationResponse -> ShowS
$cshowsPrec :: Int -> CreateDataRepositoryAssociationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateDataRepositoryAssociationResponse x
-> CreateDataRepositoryAssociationResponse
forall x.
CreateDataRepositoryAssociationResponse
-> Rep CreateDataRepositoryAssociationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDataRepositoryAssociationResponse x
-> CreateDataRepositoryAssociationResponse
$cfrom :: forall x.
CreateDataRepositoryAssociationResponse
-> Rep CreateDataRepositoryAssociationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDataRepositoryAssociationResponse' 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:
--
-- 'association', 'createDataRepositoryAssociationResponse_association' - The response object returned after the data repository association is
-- created.
--
-- 'httpStatus', 'createDataRepositoryAssociationResponse_httpStatus' - The response's http status code.
newCreateDataRepositoryAssociationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDataRepositoryAssociationResponse
newCreateDataRepositoryAssociationResponse :: Int -> CreateDataRepositoryAssociationResponse
newCreateDataRepositoryAssociationResponse
  Int
pHttpStatus_ =
    CreateDataRepositoryAssociationResponse'
      { $sel:association:CreateDataRepositoryAssociationResponse' :: Maybe DataRepositoryAssociation
association =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateDataRepositoryAssociationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The response object returned after the data repository association is
-- created.
createDataRepositoryAssociationResponse_association :: Lens.Lens' CreateDataRepositoryAssociationResponse (Prelude.Maybe DataRepositoryAssociation)
createDataRepositoryAssociationResponse_association :: Lens'
  CreateDataRepositoryAssociationResponse
  (Maybe DataRepositoryAssociation)
createDataRepositoryAssociationResponse_association = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryAssociationResponse' {Maybe DataRepositoryAssociation
association :: Maybe DataRepositoryAssociation
$sel:association:CreateDataRepositoryAssociationResponse' :: CreateDataRepositoryAssociationResponse
-> Maybe DataRepositoryAssociation
association} -> Maybe DataRepositoryAssociation
association) (\s :: CreateDataRepositoryAssociationResponse
s@CreateDataRepositoryAssociationResponse' {} Maybe DataRepositoryAssociation
a -> CreateDataRepositoryAssociationResponse
s {$sel:association:CreateDataRepositoryAssociationResponse' :: Maybe DataRepositoryAssociation
association = Maybe DataRepositoryAssociation
a} :: CreateDataRepositoryAssociationResponse)

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

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