{-# 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.CreateDataRepositoryTask
-- 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 task. You use data
-- repository tasks to perform bulk operations between your Amazon FSx file
-- system and its linked data repositories. An example of a data repository
-- task is exporting any data and metadata changes, including POSIX
-- metadata, to files, directories, and symbolic links (symlinks) from your
-- FSx file system to a linked data repository. A
-- @CreateDataRepositoryTask@ operation will fail if a data repository is
-- not linked to the FSx file system. To learn more about data repository
-- tasks, see
-- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/data-repository-tasks.html Data Repository Tasks>.
-- 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>.
module Amazonka.FSx.CreateDataRepositoryTask
  ( -- * Creating a Request
    CreateDataRepositoryTask (..),
    newCreateDataRepositoryTask,

    -- * Request Lenses
    createDataRepositoryTask_capacityToRelease,
    createDataRepositoryTask_clientRequestToken,
    createDataRepositoryTask_paths,
    createDataRepositoryTask_tags,
    createDataRepositoryTask_type,
    createDataRepositoryTask_fileSystemId,
    createDataRepositoryTask_report,

    -- * Destructuring the Response
    CreateDataRepositoryTaskResponse (..),
    newCreateDataRepositoryTaskResponse,

    -- * Response Lenses
    createDataRepositoryTaskResponse_dataRepositoryTask,
    createDataRepositoryTaskResponse_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:/ 'newCreateDataRepositoryTask' smart constructor.
data CreateDataRepositoryTask = CreateDataRepositoryTask'
  { -- | Specifies the amount of data to release, in GiB, by an Amazon File Cache
    -- @AUTO_RELEASE_DATA@ task that automatically releases files from the
    -- cache.
    CreateDataRepositoryTask -> Maybe Natural
capacityToRelease :: Prelude.Maybe Prelude.Natural,
    CreateDataRepositoryTask -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | A list of paths for the data repository task to use when the task is
    -- processed. If a path that you provide isn\'t valid, the task fails.
    --
    -- -   For export tasks, the list contains paths on the Amazon FSx file
    --     system from which the files are exported to the Amazon S3 bucket.
    --     The default path is the file system root directory. The paths you
    --     provide need to be relative to the mount point of the file system.
    --     If the mount point is @\/mnt\/fsx@ and @\/mnt\/fsx\/path1@ is a
    --     directory or file on the file system you want to export, then the
    --     path to provide is @path1@.
    --
    -- -   For import tasks, the list contains paths in the Amazon S3 bucket
    --     from which POSIX metadata changes are imported to the Amazon FSx
    --     file system. The path can be an S3 bucket or prefix in the format
    --     @s3:\/\/myBucket\/myPrefix@ (where @myPrefix@ is optional).
    CreateDataRepositoryTask -> Maybe [Text]
paths :: Prelude.Maybe [Prelude.Text],
    CreateDataRepositoryTask -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | Specifies the type of data repository task to create.
    CreateDataRepositoryTask -> DataRepositoryTaskType
type' :: DataRepositoryTaskType,
    CreateDataRepositoryTask -> Text
fileSystemId :: Prelude.Text,
    -- | Defines whether or not Amazon FSx provides a CompletionReport once the
    -- task has completed. A CompletionReport provides a detailed report on the
    -- files that Amazon FSx processed that meet the criteria specified by the
    -- @Scope@ parameter. For more information, see
    -- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/task-completion-report.html Working with Task Completion Reports>.
    CreateDataRepositoryTask -> CompletionReport
report :: CompletionReport
  }
  deriving (CreateDataRepositoryTask -> CreateDataRepositoryTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDataRepositoryTask -> CreateDataRepositoryTask -> Bool
$c/= :: CreateDataRepositoryTask -> CreateDataRepositoryTask -> Bool
== :: CreateDataRepositoryTask -> CreateDataRepositoryTask -> Bool
$c== :: CreateDataRepositoryTask -> CreateDataRepositoryTask -> Bool
Prelude.Eq, ReadPrec [CreateDataRepositoryTask]
ReadPrec CreateDataRepositoryTask
Int -> ReadS CreateDataRepositoryTask
ReadS [CreateDataRepositoryTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDataRepositoryTask]
$creadListPrec :: ReadPrec [CreateDataRepositoryTask]
readPrec :: ReadPrec CreateDataRepositoryTask
$creadPrec :: ReadPrec CreateDataRepositoryTask
readList :: ReadS [CreateDataRepositoryTask]
$creadList :: ReadS [CreateDataRepositoryTask]
readsPrec :: Int -> ReadS CreateDataRepositoryTask
$creadsPrec :: Int -> ReadS CreateDataRepositoryTask
Prelude.Read, Int -> CreateDataRepositoryTask -> ShowS
[CreateDataRepositoryTask] -> ShowS
CreateDataRepositoryTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDataRepositoryTask] -> ShowS
$cshowList :: [CreateDataRepositoryTask] -> ShowS
show :: CreateDataRepositoryTask -> String
$cshow :: CreateDataRepositoryTask -> String
showsPrec :: Int -> CreateDataRepositoryTask -> ShowS
$cshowsPrec :: Int -> CreateDataRepositoryTask -> ShowS
Prelude.Show, forall x.
Rep CreateDataRepositoryTask x -> CreateDataRepositoryTask
forall x.
CreateDataRepositoryTask -> Rep CreateDataRepositoryTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDataRepositoryTask x -> CreateDataRepositoryTask
$cfrom :: forall x.
CreateDataRepositoryTask -> Rep CreateDataRepositoryTask x
Prelude.Generic)

-- |
-- Create a value of 'CreateDataRepositoryTask' 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:
--
-- 'capacityToRelease', 'createDataRepositoryTask_capacityToRelease' - Specifies the amount of data to release, in GiB, by an Amazon File Cache
-- @AUTO_RELEASE_DATA@ task that automatically releases files from the
-- cache.
--
-- 'clientRequestToken', 'createDataRepositoryTask_clientRequestToken' - Undocumented member.
--
-- 'paths', 'createDataRepositoryTask_paths' - A list of paths for the data repository task to use when the task is
-- processed. If a path that you provide isn\'t valid, the task fails.
--
-- -   For export tasks, the list contains paths on the Amazon FSx file
--     system from which the files are exported to the Amazon S3 bucket.
--     The default path is the file system root directory. The paths you
--     provide need to be relative to the mount point of the file system.
--     If the mount point is @\/mnt\/fsx@ and @\/mnt\/fsx\/path1@ is a
--     directory or file on the file system you want to export, then the
--     path to provide is @path1@.
--
-- -   For import tasks, the list contains paths in the Amazon S3 bucket
--     from which POSIX metadata changes are imported to the Amazon FSx
--     file system. The path can be an S3 bucket or prefix in the format
--     @s3:\/\/myBucket\/myPrefix@ (where @myPrefix@ is optional).
--
-- 'tags', 'createDataRepositoryTask_tags' - Undocumented member.
--
-- 'type'', 'createDataRepositoryTask_type' - Specifies the type of data repository task to create.
--
-- 'fileSystemId', 'createDataRepositoryTask_fileSystemId' - Undocumented member.
--
-- 'report', 'createDataRepositoryTask_report' - Defines whether or not Amazon FSx provides a CompletionReport once the
-- task has completed. A CompletionReport provides a detailed report on the
-- files that Amazon FSx processed that meet the criteria specified by the
-- @Scope@ parameter. For more information, see
-- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/task-completion-report.html Working with Task Completion Reports>.
newCreateDataRepositoryTask ::
  -- | 'type''
  DataRepositoryTaskType ->
  -- | 'fileSystemId'
  Prelude.Text ->
  -- | 'report'
  CompletionReport ->
  CreateDataRepositoryTask
newCreateDataRepositoryTask :: DataRepositoryTaskType
-> Text -> CompletionReport -> CreateDataRepositoryTask
newCreateDataRepositoryTask
  DataRepositoryTaskType
pType_
  Text
pFileSystemId_
  CompletionReport
pReport_ =
    CreateDataRepositoryTask'
      { $sel:capacityToRelease:CreateDataRepositoryTask' :: Maybe Natural
capacityToRelease =
          forall a. Maybe a
Prelude.Nothing,
        $sel:clientRequestToken:CreateDataRepositoryTask' :: Maybe Text
clientRequestToken = forall a. Maybe a
Prelude.Nothing,
        $sel:paths:CreateDataRepositoryTask' :: Maybe [Text]
paths = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateDataRepositoryTask' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:type':CreateDataRepositoryTask' :: DataRepositoryTaskType
type' = DataRepositoryTaskType
pType_,
        $sel:fileSystemId:CreateDataRepositoryTask' :: Text
fileSystemId = Text
pFileSystemId_,
        $sel:report:CreateDataRepositoryTask' :: CompletionReport
report = CompletionReport
pReport_
      }

-- | Specifies the amount of data to release, in GiB, by an Amazon File Cache
-- @AUTO_RELEASE_DATA@ task that automatically releases files from the
-- cache.
createDataRepositoryTask_capacityToRelease :: Lens.Lens' CreateDataRepositoryTask (Prelude.Maybe Prelude.Natural)
createDataRepositoryTask_capacityToRelease :: Lens' CreateDataRepositoryTask (Maybe Natural)
createDataRepositoryTask_capacityToRelease = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryTask' {Maybe Natural
capacityToRelease :: Maybe Natural
$sel:capacityToRelease:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe Natural
capacityToRelease} -> Maybe Natural
capacityToRelease) (\s :: CreateDataRepositoryTask
s@CreateDataRepositoryTask' {} Maybe Natural
a -> CreateDataRepositoryTask
s {$sel:capacityToRelease:CreateDataRepositoryTask' :: Maybe Natural
capacityToRelease = Maybe Natural
a} :: CreateDataRepositoryTask)

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

-- | A list of paths for the data repository task to use when the task is
-- processed. If a path that you provide isn\'t valid, the task fails.
--
-- -   For export tasks, the list contains paths on the Amazon FSx file
--     system from which the files are exported to the Amazon S3 bucket.
--     The default path is the file system root directory. The paths you
--     provide need to be relative to the mount point of the file system.
--     If the mount point is @\/mnt\/fsx@ and @\/mnt\/fsx\/path1@ is a
--     directory or file on the file system you want to export, then the
--     path to provide is @path1@.
--
-- -   For import tasks, the list contains paths in the Amazon S3 bucket
--     from which POSIX metadata changes are imported to the Amazon FSx
--     file system. The path can be an S3 bucket or prefix in the format
--     @s3:\/\/myBucket\/myPrefix@ (where @myPrefix@ is optional).
createDataRepositoryTask_paths :: Lens.Lens' CreateDataRepositoryTask (Prelude.Maybe [Prelude.Text])
createDataRepositoryTask_paths :: Lens' CreateDataRepositoryTask (Maybe [Text])
createDataRepositoryTask_paths = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryTask' {Maybe [Text]
paths :: Maybe [Text]
$sel:paths:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe [Text]
paths} -> Maybe [Text]
paths) (\s :: CreateDataRepositoryTask
s@CreateDataRepositoryTask' {} Maybe [Text]
a -> CreateDataRepositoryTask
s {$sel:paths:CreateDataRepositoryTask' :: Maybe [Text]
paths = Maybe [Text]
a} :: CreateDataRepositoryTask) 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.
createDataRepositoryTask_tags :: Lens.Lens' CreateDataRepositoryTask (Prelude.Maybe (Prelude.NonEmpty Tag))
createDataRepositoryTask_tags :: Lens' CreateDataRepositoryTask (Maybe (NonEmpty Tag))
createDataRepositoryTask_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryTask' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateDataRepositoryTask
s@CreateDataRepositoryTask' {} Maybe (NonEmpty Tag)
a -> CreateDataRepositoryTask
s {$sel:tags:CreateDataRepositoryTask' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateDataRepositoryTask) 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 type of data repository task to create.
createDataRepositoryTask_type :: Lens.Lens' CreateDataRepositoryTask DataRepositoryTaskType
createDataRepositoryTask_type :: Lens' CreateDataRepositoryTask DataRepositoryTaskType
createDataRepositoryTask_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryTask' {DataRepositoryTaskType
type' :: DataRepositoryTaskType
$sel:type':CreateDataRepositoryTask' :: CreateDataRepositoryTask -> DataRepositoryTaskType
type'} -> DataRepositoryTaskType
type') (\s :: CreateDataRepositoryTask
s@CreateDataRepositoryTask' {} DataRepositoryTaskType
a -> CreateDataRepositoryTask
s {$sel:type':CreateDataRepositoryTask' :: DataRepositoryTaskType
type' = DataRepositoryTaskType
a} :: CreateDataRepositoryTask)

-- | Undocumented member.
createDataRepositoryTask_fileSystemId :: Lens.Lens' CreateDataRepositoryTask Prelude.Text
createDataRepositoryTask_fileSystemId :: Lens' CreateDataRepositoryTask Text
createDataRepositoryTask_fileSystemId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryTask' {Text
fileSystemId :: Text
$sel:fileSystemId:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Text
fileSystemId} -> Text
fileSystemId) (\s :: CreateDataRepositoryTask
s@CreateDataRepositoryTask' {} Text
a -> CreateDataRepositoryTask
s {$sel:fileSystemId:CreateDataRepositoryTask' :: Text
fileSystemId = Text
a} :: CreateDataRepositoryTask)

-- | Defines whether or not Amazon FSx provides a CompletionReport once the
-- task has completed. A CompletionReport provides a detailed report on the
-- files that Amazon FSx processed that meet the criteria specified by the
-- @Scope@ parameter. For more information, see
-- <https://docs.aws.amazon.com/fsx/latest/LustreGuide/task-completion-report.html Working with Task Completion Reports>.
createDataRepositoryTask_report :: Lens.Lens' CreateDataRepositoryTask CompletionReport
createDataRepositoryTask_report :: Lens' CreateDataRepositoryTask CompletionReport
createDataRepositoryTask_report = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryTask' {CompletionReport
report :: CompletionReport
$sel:report:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> CompletionReport
report} -> CompletionReport
report) (\s :: CreateDataRepositoryTask
s@CreateDataRepositoryTask' {} CompletionReport
a -> CreateDataRepositoryTask
s {$sel:report:CreateDataRepositoryTask' :: CompletionReport
report = CompletionReport
a} :: CreateDataRepositoryTask)

instance Core.AWSRequest CreateDataRepositoryTask where
  type
    AWSResponse CreateDataRepositoryTask =
      CreateDataRepositoryTaskResponse
  request :: (Service -> Service)
-> CreateDataRepositoryTask -> Request CreateDataRepositoryTask
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 CreateDataRepositoryTask
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDataRepositoryTask)))
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 DataRepositoryTask -> Int -> CreateDataRepositoryTaskResponse
CreateDataRepositoryTaskResponse'
            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
"DataRepositoryTask")
            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 CreateDataRepositoryTask where
  hashWithSalt :: Int -> CreateDataRepositoryTask -> Int
hashWithSalt Int
_salt CreateDataRepositoryTask' {Maybe Natural
Maybe [Text]
Maybe (NonEmpty Tag)
Maybe Text
Text
DataRepositoryTaskType
CompletionReport
report :: CompletionReport
fileSystemId :: Text
type' :: DataRepositoryTaskType
tags :: Maybe (NonEmpty Tag)
paths :: Maybe [Text]
clientRequestToken :: Maybe Text
capacityToRelease :: Maybe Natural
$sel:report:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> CompletionReport
$sel:fileSystemId:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Text
$sel:type':CreateDataRepositoryTask' :: CreateDataRepositoryTask -> DataRepositoryTaskType
$sel:tags:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe (NonEmpty Tag)
$sel:paths:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe [Text]
$sel:clientRequestToken:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe Text
$sel:capacityToRelease:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
capacityToRelease
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
paths
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DataRepositoryTaskType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fileSystemId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` CompletionReport
report

instance Prelude.NFData CreateDataRepositoryTask where
  rnf :: CreateDataRepositoryTask -> ()
rnf CreateDataRepositoryTask' {Maybe Natural
Maybe [Text]
Maybe (NonEmpty Tag)
Maybe Text
Text
DataRepositoryTaskType
CompletionReport
report :: CompletionReport
fileSystemId :: Text
type' :: DataRepositoryTaskType
tags :: Maybe (NonEmpty Tag)
paths :: Maybe [Text]
clientRequestToken :: Maybe Text
capacityToRelease :: Maybe Natural
$sel:report:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> CompletionReport
$sel:fileSystemId:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Text
$sel:type':CreateDataRepositoryTask' :: CreateDataRepositoryTask -> DataRepositoryTaskType
$sel:tags:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe (NonEmpty Tag)
$sel:paths:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe [Text]
$sel:clientRequestToken:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe Text
$sel:capacityToRelease:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
capacityToRelease
      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]
paths
      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 DataRepositoryTaskType
type'
      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 CompletionReport
report

instance Data.ToHeaders CreateDataRepositoryTask where
  toHeaders :: CreateDataRepositoryTask -> 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.CreateDataRepositoryTask" ::
                          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 CreateDataRepositoryTask where
  toJSON :: CreateDataRepositoryTask -> Value
toJSON CreateDataRepositoryTask' {Maybe Natural
Maybe [Text]
Maybe (NonEmpty Tag)
Maybe Text
Text
DataRepositoryTaskType
CompletionReport
report :: CompletionReport
fileSystemId :: Text
type' :: DataRepositoryTaskType
tags :: Maybe (NonEmpty Tag)
paths :: Maybe [Text]
clientRequestToken :: Maybe Text
capacityToRelease :: Maybe Natural
$sel:report:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> CompletionReport
$sel:fileSystemId:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Text
$sel:type':CreateDataRepositoryTask' :: CreateDataRepositoryTask -> DataRepositoryTaskType
$sel:tags:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe (NonEmpty Tag)
$sel:paths:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe [Text]
$sel:clientRequestToken:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe Text
$sel:capacityToRelease:CreateDataRepositoryTask' :: CreateDataRepositoryTask -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CapacityToRelease" 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
capacityToRelease,
            (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
"Paths" 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]
paths,
            (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
"Type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DataRepositoryTaskType
type'),
            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
"Report" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= CompletionReport
report)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateDataRepositoryTaskResponse' 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:
--
-- 'dataRepositoryTask', 'createDataRepositoryTaskResponse_dataRepositoryTask' - The description of the data repository task that you just created.
--
-- 'httpStatus', 'createDataRepositoryTaskResponse_httpStatus' - The response's http status code.
newCreateDataRepositoryTaskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDataRepositoryTaskResponse
newCreateDataRepositoryTaskResponse :: Int -> CreateDataRepositoryTaskResponse
newCreateDataRepositoryTaskResponse Int
pHttpStatus_ =
  CreateDataRepositoryTaskResponse'
    { $sel:dataRepositoryTask:CreateDataRepositoryTaskResponse' :: Maybe DataRepositoryTask
dataRepositoryTask =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDataRepositoryTaskResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The description of the data repository task that you just created.
createDataRepositoryTaskResponse_dataRepositoryTask :: Lens.Lens' CreateDataRepositoryTaskResponse (Prelude.Maybe DataRepositoryTask)
createDataRepositoryTaskResponse_dataRepositoryTask :: Lens' CreateDataRepositoryTaskResponse (Maybe DataRepositoryTask)
createDataRepositoryTaskResponse_dataRepositoryTask = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataRepositoryTaskResponse' {Maybe DataRepositoryTask
dataRepositoryTask :: Maybe DataRepositoryTask
$sel:dataRepositoryTask:CreateDataRepositoryTaskResponse' :: CreateDataRepositoryTaskResponse -> Maybe DataRepositoryTask
dataRepositoryTask} -> Maybe DataRepositoryTask
dataRepositoryTask) (\s :: CreateDataRepositoryTaskResponse
s@CreateDataRepositoryTaskResponse' {} Maybe DataRepositoryTask
a -> CreateDataRepositoryTaskResponse
s {$sel:dataRepositoryTask:CreateDataRepositoryTaskResponse' :: Maybe DataRepositoryTask
dataRepositoryTask = Maybe DataRepositoryTask
a} :: CreateDataRepositoryTaskResponse)

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

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