{-# 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.StartTaskExecution
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts an DataSync task. For each task, you can only run one task
-- execution at a time.
--
-- There are several phases to a task execution. For more information, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/working-with-task-executions.html#understand-task-execution-statuses Task execution statuses>.
module Amazonka.DataSync.StartTaskExecution
  ( -- * Creating a Request
    StartTaskExecution (..),
    newStartTaskExecution,

    -- * Request Lenses
    startTaskExecution_excludes,
    startTaskExecution_includes,
    startTaskExecution_overrideOptions,
    startTaskExecution_tags,
    startTaskExecution_taskArn,

    -- * Destructuring the Response
    StartTaskExecutionResponse (..),
    newStartTaskExecutionResponse,

    -- * Response Lenses
    startTaskExecutionResponse_taskExecutionArn,
    startTaskExecutionResponse_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

-- | StartTaskExecutionRequest
--
-- /See:/ 'newStartTaskExecution' smart constructor.
data StartTaskExecution = StartTaskExecution'
  { -- | Specifies a list of filter rules that determines which files to exclude
    -- from a task. The list contains a single filter string that consists of
    -- the patterns to exclude. The patterns are delimited by \"|\" (that is, a
    -- pipe), for example, @\"\/folder1|\/folder2\"@.
    StartTaskExecution -> Maybe [FilterRule]
excludes :: Prelude.Maybe [FilterRule],
    -- | Specifies a list of filter rules that determines which files to include
    -- when running a task. The pattern should contain a single filter string
    -- that consists of the patterns to include. The patterns are delimited by
    -- \"|\" (that is, a pipe), for example, @\"\/folder1|\/folder2\"@.
    StartTaskExecution -> Maybe [FilterRule]
includes :: Prelude.Maybe [FilterRule],
    StartTaskExecution -> Maybe Options
overrideOptions :: Prelude.Maybe Options,
    -- | Specifies the tags that you want to apply to the Amazon Resource Name
    -- (ARN) representing the task execution.
    --
    -- /Tags/ are key-value pairs that help you manage, filter, and search for
    -- your DataSync resources.
    StartTaskExecution -> Maybe [TagListEntry]
tags :: Prelude.Maybe [TagListEntry],
    -- | Specifies the Amazon Resource Name (ARN) of the task that you want to
    -- start.
    StartTaskExecution -> Text
taskArn :: Prelude.Text
  }
  deriving (StartTaskExecution -> StartTaskExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartTaskExecution -> StartTaskExecution -> Bool
$c/= :: StartTaskExecution -> StartTaskExecution -> Bool
== :: StartTaskExecution -> StartTaskExecution -> Bool
$c== :: StartTaskExecution -> StartTaskExecution -> Bool
Prelude.Eq, ReadPrec [StartTaskExecution]
ReadPrec StartTaskExecution
Int -> ReadS StartTaskExecution
ReadS [StartTaskExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartTaskExecution]
$creadListPrec :: ReadPrec [StartTaskExecution]
readPrec :: ReadPrec StartTaskExecution
$creadPrec :: ReadPrec StartTaskExecution
readList :: ReadS [StartTaskExecution]
$creadList :: ReadS [StartTaskExecution]
readsPrec :: Int -> ReadS StartTaskExecution
$creadsPrec :: Int -> ReadS StartTaskExecution
Prelude.Read, Int -> StartTaskExecution -> ShowS
[StartTaskExecution] -> ShowS
StartTaskExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartTaskExecution] -> ShowS
$cshowList :: [StartTaskExecution] -> ShowS
show :: StartTaskExecution -> String
$cshow :: StartTaskExecution -> String
showsPrec :: Int -> StartTaskExecution -> ShowS
$cshowsPrec :: Int -> StartTaskExecution -> ShowS
Prelude.Show, forall x. Rep StartTaskExecution x -> StartTaskExecution
forall x. StartTaskExecution -> Rep StartTaskExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartTaskExecution x -> StartTaskExecution
$cfrom :: forall x. StartTaskExecution -> Rep StartTaskExecution x
Prelude.Generic)

-- |
-- Create a value of 'StartTaskExecution' 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:
--
-- 'excludes', 'startTaskExecution_excludes' - Specifies a list of filter rules that determines which files to exclude
-- from a task. The list contains a single filter string that consists of
-- the patterns to exclude. The patterns are delimited by \"|\" (that is, a
-- pipe), for example, @\"\/folder1|\/folder2\"@.
--
-- 'includes', 'startTaskExecution_includes' - Specifies a list of filter rules that determines which files to include
-- when running a task. The pattern should contain a single filter string
-- that consists of the patterns to include. The patterns are delimited by
-- \"|\" (that is, a pipe), for example, @\"\/folder1|\/folder2\"@.
--
-- 'overrideOptions', 'startTaskExecution_overrideOptions' - Undocumented member.
--
-- 'tags', 'startTaskExecution_tags' - Specifies the tags that you want to apply to the Amazon Resource Name
-- (ARN) representing the task execution.
--
-- /Tags/ are key-value pairs that help you manage, filter, and search for
-- your DataSync resources.
--
-- 'taskArn', 'startTaskExecution_taskArn' - Specifies the Amazon Resource Name (ARN) of the task that you want to
-- start.
newStartTaskExecution ::
  -- | 'taskArn'
  Prelude.Text ->
  StartTaskExecution
newStartTaskExecution :: Text -> StartTaskExecution
newStartTaskExecution Text
pTaskArn_ =
  StartTaskExecution'
    { $sel:excludes:StartTaskExecution' :: Maybe [FilterRule]
excludes = forall a. Maybe a
Prelude.Nothing,
      $sel:includes:StartTaskExecution' :: Maybe [FilterRule]
includes = forall a. Maybe a
Prelude.Nothing,
      $sel:overrideOptions:StartTaskExecution' :: Maybe Options
overrideOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:StartTaskExecution' :: Maybe [TagListEntry]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:taskArn:StartTaskExecution' :: Text
taskArn = Text
pTaskArn_
    }

-- | Specifies a list of filter rules that determines which files to exclude
-- from a task. The list contains a single filter string that consists of
-- the patterns to exclude. The patterns are delimited by \"|\" (that is, a
-- pipe), for example, @\"\/folder1|\/folder2\"@.
startTaskExecution_excludes :: Lens.Lens' StartTaskExecution (Prelude.Maybe [FilterRule])
startTaskExecution_excludes :: Lens' StartTaskExecution (Maybe [FilterRule])
startTaskExecution_excludes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTaskExecution' {Maybe [FilterRule]
excludes :: Maybe [FilterRule]
$sel:excludes:StartTaskExecution' :: StartTaskExecution -> Maybe [FilterRule]
excludes} -> Maybe [FilterRule]
excludes) (\s :: StartTaskExecution
s@StartTaskExecution' {} Maybe [FilterRule]
a -> StartTaskExecution
s {$sel:excludes:StartTaskExecution' :: Maybe [FilterRule]
excludes = Maybe [FilterRule]
a} :: StartTaskExecution) 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 determines which files to include
-- when running a task. The pattern should contain a single filter string
-- that consists of the patterns to include. The patterns are delimited by
-- \"|\" (that is, a pipe), for example, @\"\/folder1|\/folder2\"@.
startTaskExecution_includes :: Lens.Lens' StartTaskExecution (Prelude.Maybe [FilterRule])
startTaskExecution_includes :: Lens' StartTaskExecution (Maybe [FilterRule])
startTaskExecution_includes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTaskExecution' {Maybe [FilterRule]
includes :: Maybe [FilterRule]
$sel:includes:StartTaskExecution' :: StartTaskExecution -> Maybe [FilterRule]
includes} -> Maybe [FilterRule]
includes) (\s :: StartTaskExecution
s@StartTaskExecution' {} Maybe [FilterRule]
a -> StartTaskExecution
s {$sel:includes:StartTaskExecution' :: Maybe [FilterRule]
includes = Maybe [FilterRule]
a} :: StartTaskExecution) 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.
startTaskExecution_overrideOptions :: Lens.Lens' StartTaskExecution (Prelude.Maybe Options)
startTaskExecution_overrideOptions :: Lens' StartTaskExecution (Maybe Options)
startTaskExecution_overrideOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTaskExecution' {Maybe Options
overrideOptions :: Maybe Options
$sel:overrideOptions:StartTaskExecution' :: StartTaskExecution -> Maybe Options
overrideOptions} -> Maybe Options
overrideOptions) (\s :: StartTaskExecution
s@StartTaskExecution' {} Maybe Options
a -> StartTaskExecution
s {$sel:overrideOptions:StartTaskExecution' :: Maybe Options
overrideOptions = Maybe Options
a} :: StartTaskExecution)

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

instance Core.AWSRequest StartTaskExecution where
  type
    AWSResponse StartTaskExecution =
      StartTaskExecutionResponse
  request :: (Service -> Service)
-> StartTaskExecution -> Request StartTaskExecution
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 StartTaskExecution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartTaskExecution)))
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 -> StartTaskExecutionResponse
StartTaskExecutionResponse'
            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
"TaskExecutionArn")
            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 StartTaskExecution where
  hashWithSalt :: Int -> StartTaskExecution -> Int
hashWithSalt Int
_salt StartTaskExecution' {Maybe [FilterRule]
Maybe [TagListEntry]
Maybe Options
Text
taskArn :: Text
tags :: Maybe [TagListEntry]
overrideOptions :: Maybe Options
includes :: Maybe [FilterRule]
excludes :: Maybe [FilterRule]
$sel:taskArn:StartTaskExecution' :: StartTaskExecution -> Text
$sel:tags:StartTaskExecution' :: StartTaskExecution -> Maybe [TagListEntry]
$sel:overrideOptions:StartTaskExecution' :: StartTaskExecution -> Maybe Options
$sel:includes:StartTaskExecution' :: StartTaskExecution -> Maybe [FilterRule]
$sel:excludes:StartTaskExecution' :: StartTaskExecution -> Maybe [FilterRule]
..} =
    Int
_salt
      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 Options
overrideOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagListEntry]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
taskArn

instance Prelude.NFData StartTaskExecution where
  rnf :: StartTaskExecution -> ()
rnf StartTaskExecution' {Maybe [FilterRule]
Maybe [TagListEntry]
Maybe Options
Text
taskArn :: Text
tags :: Maybe [TagListEntry]
overrideOptions :: Maybe Options
includes :: Maybe [FilterRule]
excludes :: Maybe [FilterRule]
$sel:taskArn:StartTaskExecution' :: StartTaskExecution -> Text
$sel:tags:StartTaskExecution' :: StartTaskExecution -> Maybe [TagListEntry]
$sel:overrideOptions:StartTaskExecution' :: StartTaskExecution -> Maybe Options
$sel:includes:StartTaskExecution' :: StartTaskExecution -> Maybe [FilterRule]
$sel:excludes:StartTaskExecution' :: StartTaskExecution -> Maybe [FilterRule]
..} =
    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 Options
overrideOptions
      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
taskArn

instance Data.ToHeaders StartTaskExecution where
  toHeaders :: StartTaskExecution -> 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.StartTaskExecution" ::
                          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 StartTaskExecution where
  toJSON :: StartTaskExecution -> Value
toJSON StartTaskExecution' {Maybe [FilterRule]
Maybe [TagListEntry]
Maybe Options
Text
taskArn :: Text
tags :: Maybe [TagListEntry]
overrideOptions :: Maybe Options
includes :: Maybe [FilterRule]
excludes :: Maybe [FilterRule]
$sel:taskArn:StartTaskExecution' :: StartTaskExecution -> Text
$sel:tags:StartTaskExecution' :: StartTaskExecution -> Maybe [TagListEntry]
$sel:overrideOptions:StartTaskExecution' :: StartTaskExecution -> Maybe Options
$sel:includes:StartTaskExecution' :: StartTaskExecution -> Maybe [FilterRule]
$sel:excludes:StartTaskExecution' :: StartTaskExecution -> Maybe [FilterRule]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"OverrideOptions" 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
overrideOptions,
            (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
"TaskArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
taskArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'StartTaskExecutionResponse' 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:
--
-- 'taskExecutionArn', 'startTaskExecutionResponse_taskExecutionArn' - The ARN of the running task execution.
--
-- 'httpStatus', 'startTaskExecutionResponse_httpStatus' - The response's http status code.
newStartTaskExecutionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartTaskExecutionResponse
newStartTaskExecutionResponse :: Int -> StartTaskExecutionResponse
newStartTaskExecutionResponse Int
pHttpStatus_ =
  StartTaskExecutionResponse'
    { $sel:taskExecutionArn:StartTaskExecutionResponse' :: Maybe Text
taskExecutionArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartTaskExecutionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the running task execution.
startTaskExecutionResponse_taskExecutionArn :: Lens.Lens' StartTaskExecutionResponse (Prelude.Maybe Prelude.Text)
startTaskExecutionResponse_taskExecutionArn :: Lens' StartTaskExecutionResponse (Maybe Text)
startTaskExecutionResponse_taskExecutionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTaskExecutionResponse' {Maybe Text
taskExecutionArn :: Maybe Text
$sel:taskExecutionArn:StartTaskExecutionResponse' :: StartTaskExecutionResponse -> Maybe Text
taskExecutionArn} -> Maybe Text
taskExecutionArn) (\s :: StartTaskExecutionResponse
s@StartTaskExecutionResponse' {} Maybe Text
a -> StartTaskExecutionResponse
s {$sel:taskExecutionArn:StartTaskExecutionResponse' :: Maybe Text
taskExecutionArn = Maybe Text
a} :: StartTaskExecutionResponse)

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

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