{-# 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.DataSync.CreateTask
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Configures a task, which defines where and how DataSync transfers your
-- data.
--
-- A task includes a source location, a destination location, and the
-- preferences for how and when you want to transfer your data (such as
-- bandwidth limits, scheduling, among other options).
module Amazonka.DataSync.CreateTask
  ( -- * Creating a Request
    CreateTask (..),
    newCreateTask,

    -- * Request Lenses
    createTask_cloudWatchLogGroupArn,
    createTask_excludes,
    createTask_includes,
    createTask_name,
    createTask_options,
    createTask_schedule,
    createTask_tags,
    createTask_sourceLocationArn,
    createTask_destinationLocationArn,

    -- * Destructuring the Response
    CreateTaskResponse (..),
    newCreateTaskResponse,

    -- * Response Lenses
    createTaskResponse_taskArn,
    createTaskResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DataSync.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | CreateTaskRequest
--
-- /See:/ 'newCreateTask' smart constructor.
data CreateTask = CreateTask'
  { -- | The Amazon Resource Name (ARN) of the Amazon CloudWatch log group that
    -- is used to monitor and log events in the task.
    CreateTask -> Maybe Text
cloudWatchLogGroupArn :: Prelude.Maybe Prelude.Text,
    -- | Specifies a list of filter rules that exclude specific data during your
    -- transfer. For more information and examples, see
    -- <https://docs.aws.amazon.com/datasync/latest/userguide/filtering.html Filtering data transferred by DataSync>.
    CreateTask -> Maybe [FilterRule]
excludes :: Prelude.Maybe [FilterRule],
    -- | Specifies a list of filter rules that include specific data during your
    -- transfer. For more information and examples, see
    -- <https://docs.aws.amazon.com/datasync/latest/userguide/filtering.html Filtering data transferred by DataSync>.
    CreateTask -> Maybe [FilterRule]
includes :: Prelude.Maybe [FilterRule],
    -- | The name of a task. This value is a text reference that is used to
    -- identify the task in the console.
    CreateTask -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Specifies the configuration options for a task. Some options include
    -- preserving file or object metadata and verifying data integrity.
    --
    -- You can also override these options before starting an individual run of
    -- a task (also known as a /task execution/). For more information, see
    -- <https://docs.aws.amazon.com/datasync/latest/userguide/API_StartTaskExecution.html StartTaskExecution>.
    CreateTask -> Maybe Options
options :: Prelude.Maybe Options,
    -- | Specifies a schedule used to periodically transfer files from a source
    -- to a destination location. The schedule should be specified in UTC time.
    -- For more information, see
    -- <https://docs.aws.amazon.com/datasync/latest/userguide/task-scheduling.html Scheduling your task>.
    CreateTask -> Maybe TaskSchedule
schedule :: Prelude.Maybe TaskSchedule,
    -- | Specifies the tags that you want to apply to the Amazon Resource Name
    -- (ARN) representing the task.
    --
    -- /Tags/ are key-value pairs that help you manage, filter, and search for
    -- your DataSync resources.
    CreateTask -> Maybe [TagListEntry]
tags :: Prelude.Maybe [TagListEntry],
    -- | The Amazon Resource Name (ARN) of the source location for the task.
    CreateTask -> Text
sourceLocationArn :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of an Amazon Web Services storage
    -- resource\'s location.
    CreateTask -> Text
destinationLocationArn :: Prelude.Text
  }
  deriving (CreateTask -> CreateTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTask -> CreateTask -> Bool
$c/= :: CreateTask -> CreateTask -> Bool
== :: CreateTask -> CreateTask -> Bool
$c== :: CreateTask -> CreateTask -> Bool
Prelude.Eq, ReadPrec [CreateTask]
ReadPrec CreateTask
Int -> ReadS CreateTask
ReadS [CreateTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTask]
$creadListPrec :: ReadPrec [CreateTask]
readPrec :: ReadPrec CreateTask
$creadPrec :: ReadPrec CreateTask
readList :: ReadS [CreateTask]
$creadList :: ReadS [CreateTask]
readsPrec :: Int -> ReadS CreateTask
$creadsPrec :: Int -> ReadS CreateTask
Prelude.Read, Int -> CreateTask -> ShowS
[CreateTask] -> ShowS
CreateTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTask] -> ShowS
$cshowList :: [CreateTask] -> ShowS
show :: CreateTask -> String
$cshow :: CreateTask -> String
showsPrec :: Int -> CreateTask -> ShowS
$cshowsPrec :: Int -> CreateTask -> ShowS
Prelude.Show, forall x. Rep CreateTask x -> CreateTask
forall x. CreateTask -> Rep CreateTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTask x -> CreateTask
$cfrom :: forall x. CreateTask -> Rep CreateTask x
Prelude.Generic)

-- |
-- Create a value of 'CreateTask' 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:
--
-- 'cloudWatchLogGroupArn', 'createTask_cloudWatchLogGroupArn' - The Amazon Resource Name (ARN) of the Amazon CloudWatch log group that
-- is used to monitor and log events in the task.
--
-- 'excludes', 'createTask_excludes' - Specifies a list of filter rules that exclude specific data during your
-- transfer. For more information and examples, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/filtering.html Filtering data transferred by DataSync>.
--
-- 'includes', 'createTask_includes' - Specifies a list of filter rules that include specific data during your
-- transfer. For more information and examples, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/filtering.html Filtering data transferred by DataSync>.
--
-- 'name', 'createTask_name' - The name of a task. This value is a text reference that is used to
-- identify the task in the console.
--
-- 'options', 'createTask_options' - Specifies the configuration options for a task. Some options include
-- preserving file or object metadata and verifying data integrity.
--
-- You can also override these options before starting an individual run of
-- a task (also known as a /task execution/). For more information, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/API_StartTaskExecution.html StartTaskExecution>.
--
-- 'schedule', 'createTask_schedule' - Specifies a schedule used to periodically transfer files from a source
-- to a destination location. The schedule should be specified in UTC time.
-- For more information, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/task-scheduling.html Scheduling your task>.
--
-- 'tags', 'createTask_tags' - Specifies the tags that you want to apply to the Amazon Resource Name
-- (ARN) representing the task.
--
-- /Tags/ are key-value pairs that help you manage, filter, and search for
-- your DataSync resources.
--
-- 'sourceLocationArn', 'createTask_sourceLocationArn' - The Amazon Resource Name (ARN) of the source location for the task.
--
-- 'destinationLocationArn', 'createTask_destinationLocationArn' - The Amazon Resource Name (ARN) of an Amazon Web Services storage
-- resource\'s location.
newCreateTask ::
  -- | 'sourceLocationArn'
  Prelude.Text ->
  -- | 'destinationLocationArn'
  Prelude.Text ->
  CreateTask
newCreateTask :: Text -> Text -> CreateTask
newCreateTask
  Text
pSourceLocationArn_
  Text
pDestinationLocationArn_ =
    CreateTask'
      { $sel:cloudWatchLogGroupArn:CreateTask' :: Maybe Text
cloudWatchLogGroupArn =
          forall a. Maybe a
Prelude.Nothing,
        $sel:excludes:CreateTask' :: Maybe [FilterRule]
excludes = forall a. Maybe a
Prelude.Nothing,
        $sel:includes:CreateTask' :: Maybe [FilterRule]
includes = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateTask' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
        $sel:options:CreateTask' :: Maybe Options
options = forall a. Maybe a
Prelude.Nothing,
        $sel:schedule:CreateTask' :: Maybe TaskSchedule
schedule = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateTask' :: Maybe [TagListEntry]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceLocationArn:CreateTask' :: Text
sourceLocationArn = Text
pSourceLocationArn_,
        $sel:destinationLocationArn:CreateTask' :: Text
destinationLocationArn = Text
pDestinationLocationArn_
      }

-- | The Amazon Resource Name (ARN) of the Amazon CloudWatch log group that
-- is used to monitor and log events in the task.
createTask_cloudWatchLogGroupArn :: Lens.Lens' CreateTask (Prelude.Maybe Prelude.Text)
createTask_cloudWatchLogGroupArn :: Lens' CreateTask (Maybe Text)
createTask_cloudWatchLogGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {Maybe Text
cloudWatchLogGroupArn :: Maybe Text
$sel:cloudWatchLogGroupArn:CreateTask' :: CreateTask -> Maybe Text
cloudWatchLogGroupArn} -> Maybe Text
cloudWatchLogGroupArn) (\s :: CreateTask
s@CreateTask' {} Maybe Text
a -> CreateTask
s {$sel:cloudWatchLogGroupArn:CreateTask' :: Maybe Text
cloudWatchLogGroupArn = Maybe Text
a} :: CreateTask)

-- | Specifies a list of filter rules that exclude specific data during your
-- transfer. For more information and examples, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/filtering.html Filtering data transferred by DataSync>.
createTask_excludes :: Lens.Lens' CreateTask (Prelude.Maybe [FilterRule])
createTask_excludes :: Lens' CreateTask (Maybe [FilterRule])
createTask_excludes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {Maybe [FilterRule]
excludes :: Maybe [FilterRule]
$sel:excludes:CreateTask' :: CreateTask -> Maybe [FilterRule]
excludes} -> Maybe [FilterRule]
excludes) (\s :: CreateTask
s@CreateTask' {} Maybe [FilterRule]
a -> CreateTask
s {$sel:excludes:CreateTask' :: Maybe [FilterRule]
excludes = Maybe [FilterRule]
a} :: CreateTask) 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 a list of filter rules that include specific data during your
-- transfer. For more information and examples, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/filtering.html Filtering data transferred by DataSync>.
createTask_includes :: Lens.Lens' CreateTask (Prelude.Maybe [FilterRule])
createTask_includes :: Lens' CreateTask (Maybe [FilterRule])
createTask_includes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {Maybe [FilterRule]
includes :: Maybe [FilterRule]
$sel:includes:CreateTask' :: CreateTask -> Maybe [FilterRule]
includes} -> Maybe [FilterRule]
includes) (\s :: CreateTask
s@CreateTask' {} Maybe [FilterRule]
a -> CreateTask
s {$sel:includes:CreateTask' :: Maybe [FilterRule]
includes = Maybe [FilterRule]
a} :: CreateTask) 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 name of a task. This value is a text reference that is used to
-- identify the task in the console.
createTask_name :: Lens.Lens' CreateTask (Prelude.Maybe Prelude.Text)
createTask_name :: Lens' CreateTask (Maybe Text)
createTask_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {Maybe Text
name :: Maybe Text
$sel:name:CreateTask' :: CreateTask -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateTask
s@CreateTask' {} Maybe Text
a -> CreateTask
s {$sel:name:CreateTask' :: Maybe Text
name = Maybe Text
a} :: CreateTask)

-- | Specifies the configuration options for a task. Some options include
-- preserving file or object metadata and verifying data integrity.
--
-- You can also override these options before starting an individual run of
-- a task (also known as a /task execution/). For more information, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/API_StartTaskExecution.html StartTaskExecution>.
createTask_options :: Lens.Lens' CreateTask (Prelude.Maybe Options)
createTask_options :: Lens' CreateTask (Maybe Options)
createTask_options = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {Maybe Options
options :: Maybe Options
$sel:options:CreateTask' :: CreateTask -> Maybe Options
options} -> Maybe Options
options) (\s :: CreateTask
s@CreateTask' {} Maybe Options
a -> CreateTask
s {$sel:options:CreateTask' :: Maybe Options
options = Maybe Options
a} :: CreateTask)

-- | Specifies a schedule used to periodically transfer files from a source
-- to a destination location. The schedule should be specified in UTC time.
-- For more information, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/task-scheduling.html Scheduling your task>.
createTask_schedule :: Lens.Lens' CreateTask (Prelude.Maybe TaskSchedule)
createTask_schedule :: Lens' CreateTask (Maybe TaskSchedule)
createTask_schedule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {Maybe TaskSchedule
schedule :: Maybe TaskSchedule
$sel:schedule:CreateTask' :: CreateTask -> Maybe TaskSchedule
schedule} -> Maybe TaskSchedule
schedule) (\s :: CreateTask
s@CreateTask' {} Maybe TaskSchedule
a -> CreateTask
s {$sel:schedule:CreateTask' :: Maybe TaskSchedule
schedule = Maybe TaskSchedule
a} :: CreateTask)

-- | Specifies the tags that you want to apply to the Amazon Resource Name
-- (ARN) representing the task.
--
-- /Tags/ are key-value pairs that help you manage, filter, and search for
-- your DataSync resources.
createTask_tags :: Lens.Lens' CreateTask (Prelude.Maybe [TagListEntry])
createTask_tags :: Lens' CreateTask (Maybe [TagListEntry])
createTask_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {Maybe [TagListEntry]
tags :: Maybe [TagListEntry]
$sel:tags:CreateTask' :: CreateTask -> Maybe [TagListEntry]
tags} -> Maybe [TagListEntry]
tags) (\s :: CreateTask
s@CreateTask' {} Maybe [TagListEntry]
a -> CreateTask
s {$sel:tags:CreateTask' :: Maybe [TagListEntry]
tags = Maybe [TagListEntry]
a} :: CreateTask) 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 Amazon Resource Name (ARN) of the source location for the task.
createTask_sourceLocationArn :: Lens.Lens' CreateTask Prelude.Text
createTask_sourceLocationArn :: Lens' CreateTask Text
createTask_sourceLocationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {Text
sourceLocationArn :: Text
$sel:sourceLocationArn:CreateTask' :: CreateTask -> Text
sourceLocationArn} -> Text
sourceLocationArn) (\s :: CreateTask
s@CreateTask' {} Text
a -> CreateTask
s {$sel:sourceLocationArn:CreateTask' :: Text
sourceLocationArn = Text
a} :: CreateTask)

-- | The Amazon Resource Name (ARN) of an Amazon Web Services storage
-- resource\'s location.
createTask_destinationLocationArn :: Lens.Lens' CreateTask Prelude.Text
createTask_destinationLocationArn :: Lens' CreateTask Text
createTask_destinationLocationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTask' {Text
destinationLocationArn :: Text
$sel:destinationLocationArn:CreateTask' :: CreateTask -> Text
destinationLocationArn} -> Text
destinationLocationArn) (\s :: CreateTask
s@CreateTask' {} Text
a -> CreateTask
s {$sel:destinationLocationArn:CreateTask' :: Text
destinationLocationArn = Text
a} :: CreateTask)

instance Core.AWSRequest CreateTask where
  type AWSResponse CreateTask = CreateTaskResponse
  request :: (Service -> Service) -> CreateTask -> Request CreateTask
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 CreateTask
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateTask)))
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 Text -> Int -> CreateTaskResponse
CreateTaskResponse'
            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
"TaskArn")
            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 CreateTask where
  hashWithSalt :: Int -> CreateTask -> Int
hashWithSalt Int
_salt CreateTask' {Maybe [FilterRule]
Maybe [TagListEntry]
Maybe Text
Maybe TaskSchedule
Maybe Options
Text
destinationLocationArn :: Text
sourceLocationArn :: Text
tags :: Maybe [TagListEntry]
schedule :: Maybe TaskSchedule
options :: Maybe Options
name :: Maybe Text
includes :: Maybe [FilterRule]
excludes :: Maybe [FilterRule]
cloudWatchLogGroupArn :: Maybe Text
$sel:destinationLocationArn:CreateTask' :: CreateTask -> Text
$sel:sourceLocationArn:CreateTask' :: CreateTask -> Text
$sel:tags:CreateTask' :: CreateTask -> Maybe [TagListEntry]
$sel:schedule:CreateTask' :: CreateTask -> Maybe TaskSchedule
$sel:options:CreateTask' :: CreateTask -> Maybe Options
$sel:name:CreateTask' :: CreateTask -> Maybe Text
$sel:includes:CreateTask' :: CreateTask -> Maybe [FilterRule]
$sel:excludes:CreateTask' :: CreateTask -> Maybe [FilterRule]
$sel:cloudWatchLogGroupArn:CreateTask' :: CreateTask -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cloudWatchLogGroupArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [FilterRule]
excludes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [FilterRule]
includes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Options
options
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TaskSchedule
schedule
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagListEntry]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceLocationArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationLocationArn

instance Prelude.NFData CreateTask where
  rnf :: CreateTask -> ()
rnf CreateTask' {Maybe [FilterRule]
Maybe [TagListEntry]
Maybe Text
Maybe TaskSchedule
Maybe Options
Text
destinationLocationArn :: Text
sourceLocationArn :: Text
tags :: Maybe [TagListEntry]
schedule :: Maybe TaskSchedule
options :: Maybe Options
name :: Maybe Text
includes :: Maybe [FilterRule]
excludes :: Maybe [FilterRule]
cloudWatchLogGroupArn :: Maybe Text
$sel:destinationLocationArn:CreateTask' :: CreateTask -> Text
$sel:sourceLocationArn:CreateTask' :: CreateTask -> Text
$sel:tags:CreateTask' :: CreateTask -> Maybe [TagListEntry]
$sel:schedule:CreateTask' :: CreateTask -> Maybe TaskSchedule
$sel:options:CreateTask' :: CreateTask -> Maybe Options
$sel:name:CreateTask' :: CreateTask -> Maybe Text
$sel:includes:CreateTask' :: CreateTask -> Maybe [FilterRule]
$sel:excludes:CreateTask' :: CreateTask -> Maybe [FilterRule]
$sel:cloudWatchLogGroupArn:CreateTask' :: CreateTask -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cloudWatchLogGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [FilterRule]
excludes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [FilterRule]
includes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Options
options
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TaskSchedule
schedule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagListEntry]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceLocationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationLocationArn

instance Data.ToHeaders CreateTask where
  toHeaders :: CreateTask -> 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
"FmrsService.CreateTask" :: 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 CreateTask where
  toJSON :: CreateTask -> Value
toJSON CreateTask' {Maybe [FilterRule]
Maybe [TagListEntry]
Maybe Text
Maybe TaskSchedule
Maybe Options
Text
destinationLocationArn :: Text
sourceLocationArn :: Text
tags :: Maybe [TagListEntry]
schedule :: Maybe TaskSchedule
options :: Maybe Options
name :: Maybe Text
includes :: Maybe [FilterRule]
excludes :: Maybe [FilterRule]
cloudWatchLogGroupArn :: Maybe Text
$sel:destinationLocationArn:CreateTask' :: CreateTask -> Text
$sel:sourceLocationArn:CreateTask' :: CreateTask -> Text
$sel:tags:CreateTask' :: CreateTask -> Maybe [TagListEntry]
$sel:schedule:CreateTask' :: CreateTask -> Maybe TaskSchedule
$sel:options:CreateTask' :: CreateTask -> Maybe Options
$sel:name:CreateTask' :: CreateTask -> Maybe Text
$sel:includes:CreateTask' :: CreateTask -> Maybe [FilterRule]
$sel:excludes:CreateTask' :: CreateTask -> Maybe [FilterRule]
$sel:cloudWatchLogGroupArn:CreateTask' :: CreateTask -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CloudWatchLogGroupArn" 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
cloudWatchLogGroupArn,
            (Key
"Excludes" 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 [FilterRule]
excludes,
            (Key
"Includes" 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 [FilterRule]
includes,
            (Key
"Name" 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
name,
            (Key
"Options" 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 Options
options,
            (Key
"Schedule" 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 TaskSchedule
schedule,
            (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 [TagListEntry]
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SourceLocationArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sourceLocationArn),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"DestinationLocationArn"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
destinationLocationArn
              )
          ]
      )

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

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

-- | CreateTaskResponse
--
-- /See:/ 'newCreateTaskResponse' smart constructor.
data CreateTaskResponse = CreateTaskResponse'
  { -- | The Amazon Resource Name (ARN) of the task.
    CreateTaskResponse -> Maybe Text
taskArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateTaskResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateTaskResponse -> CreateTaskResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTaskResponse -> CreateTaskResponse -> Bool
$c/= :: CreateTaskResponse -> CreateTaskResponse -> Bool
== :: CreateTaskResponse -> CreateTaskResponse -> Bool
$c== :: CreateTaskResponse -> CreateTaskResponse -> Bool
Prelude.Eq, ReadPrec [CreateTaskResponse]
ReadPrec CreateTaskResponse
Int -> ReadS CreateTaskResponse
ReadS [CreateTaskResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTaskResponse]
$creadListPrec :: ReadPrec [CreateTaskResponse]
readPrec :: ReadPrec CreateTaskResponse
$creadPrec :: ReadPrec CreateTaskResponse
readList :: ReadS [CreateTaskResponse]
$creadList :: ReadS [CreateTaskResponse]
readsPrec :: Int -> ReadS CreateTaskResponse
$creadsPrec :: Int -> ReadS CreateTaskResponse
Prelude.Read, Int -> CreateTaskResponse -> ShowS
[CreateTaskResponse] -> ShowS
CreateTaskResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTaskResponse] -> ShowS
$cshowList :: [CreateTaskResponse] -> ShowS
show :: CreateTaskResponse -> String
$cshow :: CreateTaskResponse -> String
showsPrec :: Int -> CreateTaskResponse -> ShowS
$cshowsPrec :: Int -> CreateTaskResponse -> ShowS
Prelude.Show, forall x. Rep CreateTaskResponse x -> CreateTaskResponse
forall x. CreateTaskResponse -> Rep CreateTaskResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTaskResponse x -> CreateTaskResponse
$cfrom :: forall x. CreateTaskResponse -> Rep CreateTaskResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateTaskResponse' 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:
--
-- 'taskArn', 'createTaskResponse_taskArn' - The Amazon Resource Name (ARN) of the task.
--
-- 'httpStatus', 'createTaskResponse_httpStatus' - The response's http status code.
newCreateTaskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateTaskResponse
newCreateTaskResponse :: Int -> CreateTaskResponse
newCreateTaskResponse Int
pHttpStatus_ =
  CreateTaskResponse'
    { $sel:taskArn:CreateTaskResponse' :: Maybe Text
taskArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateTaskResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the task.
createTaskResponse_taskArn :: Lens.Lens' CreateTaskResponse (Prelude.Maybe Prelude.Text)
createTaskResponse_taskArn :: Lens' CreateTaskResponse (Maybe Text)
createTaskResponse_taskArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTaskResponse' {Maybe Text
taskArn :: Maybe Text
$sel:taskArn:CreateTaskResponse' :: CreateTaskResponse -> Maybe Text
taskArn} -> Maybe Text
taskArn) (\s :: CreateTaskResponse
s@CreateTaskResponse' {} Maybe Text
a -> CreateTaskResponse
s {$sel:taskArn:CreateTaskResponse' :: Maybe Text
taskArn = Maybe Text
a} :: CreateTaskResponse)

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

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