{-# 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.DescribeTaskExecution
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns detailed metadata about a task that is being executed.
module Amazonka.DataSync.DescribeTaskExecution
  ( -- * Creating a Request
    DescribeTaskExecution (..),
    newDescribeTaskExecution,

    -- * Request Lenses
    describeTaskExecution_taskExecutionArn,

    -- * Destructuring the Response
    DescribeTaskExecutionResponse (..),
    newDescribeTaskExecutionResponse,

    -- * Response Lenses
    describeTaskExecutionResponse_bytesCompressed,
    describeTaskExecutionResponse_bytesTransferred,
    describeTaskExecutionResponse_bytesWritten,
    describeTaskExecutionResponse_estimatedBytesToTransfer,
    describeTaskExecutionResponse_estimatedFilesToTransfer,
    describeTaskExecutionResponse_excludes,
    describeTaskExecutionResponse_filesTransferred,
    describeTaskExecutionResponse_includes,
    describeTaskExecutionResponse_options,
    describeTaskExecutionResponse_result,
    describeTaskExecutionResponse_startTime,
    describeTaskExecutionResponse_status,
    describeTaskExecutionResponse_taskExecutionArn,
    describeTaskExecutionResponse_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

-- | DescribeTaskExecutionRequest
--
-- /See:/ 'newDescribeTaskExecution' smart constructor.
data DescribeTaskExecution = DescribeTaskExecution'
  { -- | The Amazon Resource Name (ARN) of the task that is being executed.
    DescribeTaskExecution -> Text
taskExecutionArn :: Prelude.Text
  }
  deriving (DescribeTaskExecution -> DescribeTaskExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeTaskExecution -> DescribeTaskExecution -> Bool
$c/= :: DescribeTaskExecution -> DescribeTaskExecution -> Bool
== :: DescribeTaskExecution -> DescribeTaskExecution -> Bool
$c== :: DescribeTaskExecution -> DescribeTaskExecution -> Bool
Prelude.Eq, ReadPrec [DescribeTaskExecution]
ReadPrec DescribeTaskExecution
Int -> ReadS DescribeTaskExecution
ReadS [DescribeTaskExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeTaskExecution]
$creadListPrec :: ReadPrec [DescribeTaskExecution]
readPrec :: ReadPrec DescribeTaskExecution
$creadPrec :: ReadPrec DescribeTaskExecution
readList :: ReadS [DescribeTaskExecution]
$creadList :: ReadS [DescribeTaskExecution]
readsPrec :: Int -> ReadS DescribeTaskExecution
$creadsPrec :: Int -> ReadS DescribeTaskExecution
Prelude.Read, Int -> DescribeTaskExecution -> ShowS
[DescribeTaskExecution] -> ShowS
DescribeTaskExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeTaskExecution] -> ShowS
$cshowList :: [DescribeTaskExecution] -> ShowS
show :: DescribeTaskExecution -> String
$cshow :: DescribeTaskExecution -> String
showsPrec :: Int -> DescribeTaskExecution -> ShowS
$cshowsPrec :: Int -> DescribeTaskExecution -> ShowS
Prelude.Show, forall x. Rep DescribeTaskExecution x -> DescribeTaskExecution
forall x. DescribeTaskExecution -> Rep DescribeTaskExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeTaskExecution x -> DescribeTaskExecution
$cfrom :: forall x. DescribeTaskExecution -> Rep DescribeTaskExecution x
Prelude.Generic)

-- |
-- Create a value of 'DescribeTaskExecution' 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', 'describeTaskExecution_taskExecutionArn' - The Amazon Resource Name (ARN) of the task that is being executed.
newDescribeTaskExecution ::
  -- | 'taskExecutionArn'
  Prelude.Text ->
  DescribeTaskExecution
newDescribeTaskExecution :: Text -> DescribeTaskExecution
newDescribeTaskExecution Text
pTaskExecutionArn_ =
  DescribeTaskExecution'
    { $sel:taskExecutionArn:DescribeTaskExecution' :: Text
taskExecutionArn =
        Text
pTaskExecutionArn_
    }

-- | The Amazon Resource Name (ARN) of the task that is being executed.
describeTaskExecution_taskExecutionArn :: Lens.Lens' DescribeTaskExecution Prelude.Text
describeTaskExecution_taskExecutionArn :: Lens' DescribeTaskExecution Text
describeTaskExecution_taskExecutionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecution' {Text
taskExecutionArn :: Text
$sel:taskExecutionArn:DescribeTaskExecution' :: DescribeTaskExecution -> Text
taskExecutionArn} -> Text
taskExecutionArn) (\s :: DescribeTaskExecution
s@DescribeTaskExecution' {} Text
a -> DescribeTaskExecution
s {$sel:taskExecutionArn:DescribeTaskExecution' :: Text
taskExecutionArn = Text
a} :: DescribeTaskExecution)

instance Core.AWSRequest DescribeTaskExecution where
  type
    AWSResponse DescribeTaskExecution =
      DescribeTaskExecutionResponse
  request :: (Service -> Service)
-> DescribeTaskExecution -> Request DescribeTaskExecution
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 DescribeTaskExecution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeTaskExecution)))
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 Integer
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> Maybe [FilterRule]
-> Maybe Integer
-> Maybe [FilterRule]
-> Maybe Options
-> Maybe TaskExecutionResultDetail
-> Maybe POSIX
-> Maybe TaskExecutionStatus
-> Maybe Text
-> Int
-> DescribeTaskExecutionResponse
DescribeTaskExecutionResponse'
            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
"BytesCompressed")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"BytesTransferred")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"BytesWritten")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"EstimatedBytesToTransfer")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"EstimatedFilesToTransfer")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Excludes" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"FilesTransferred")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Includes" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Options")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Result")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StartTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Status")
            forall (f :: * -> *) a b. Applicative f => 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 DescribeTaskExecution where
  hashWithSalt :: Int -> DescribeTaskExecution -> Int
hashWithSalt Int
_salt DescribeTaskExecution' {Text
taskExecutionArn :: Text
$sel:taskExecutionArn:DescribeTaskExecution' :: DescribeTaskExecution -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
taskExecutionArn

instance Prelude.NFData DescribeTaskExecution where
  rnf :: DescribeTaskExecution -> ()
rnf DescribeTaskExecution' {Text
taskExecutionArn :: Text
$sel:taskExecutionArn:DescribeTaskExecution' :: DescribeTaskExecution -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
taskExecutionArn

instance Data.ToHeaders DescribeTaskExecution where
  toHeaders :: DescribeTaskExecution -> 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.DescribeTaskExecution" ::
                          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 DescribeTaskExecution where
  toJSON :: DescribeTaskExecution -> Value
toJSON DescribeTaskExecution' {Text
taskExecutionArn :: Text
$sel:taskExecutionArn:DescribeTaskExecution' :: DescribeTaskExecution -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"TaskExecutionArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
taskExecutionArn)
          ]
      )

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

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

-- | DescribeTaskExecutionResponse
--
-- /See:/ 'newDescribeTaskExecutionResponse' smart constructor.
data DescribeTaskExecutionResponse = DescribeTaskExecutionResponse'
  { -- | The physical number of bytes transferred over the network after
    -- compression was applied. In most cases, this number is less than
    -- @BytesTransferred@ unless the data isn\'t compressible.
    DescribeTaskExecutionResponse -> Maybe Integer
bytesCompressed :: Prelude.Maybe Prelude.Integer,
    -- | The total number of bytes that are involved in the transfer. For the
    -- number of bytes sent over the network, see @BytesCompressed@.
    DescribeTaskExecutionResponse -> Maybe Integer
bytesTransferred :: Prelude.Maybe Prelude.Integer,
    -- | The number of logical bytes written to the destination Amazon Web
    -- Services storage resource.
    DescribeTaskExecutionResponse -> Maybe Integer
bytesWritten :: Prelude.Maybe Prelude.Integer,
    -- | The estimated physical number of bytes that is to be transferred over
    -- the network.
    DescribeTaskExecutionResponse -> Maybe Integer
estimatedBytesToTransfer :: Prelude.Maybe Prelude.Integer,
    -- | The expected number of files that is to be transferred over the network.
    -- This value is calculated during the @PREPARING@ phase before the
    -- @TRANSFERRING@ phase of the task execution. This value is the expected
    -- number of files to be transferred. It\'s calculated based on comparing
    -- the content of the source and destination locations and finding the
    -- delta that needs to be transferred.
    DescribeTaskExecutionResponse -> Maybe Integer
estimatedFilesToTransfer :: Prelude.Maybe Prelude.Integer,
    -- | 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>.
    DescribeTaskExecutionResponse -> Maybe [FilterRule]
excludes :: Prelude.Maybe [FilterRule],
    -- | The actual number of files that was transferred over the network. This
    -- value is calculated and updated on an ongoing basis during the
    -- @TRANSFERRING@ phase of the task execution. It\'s updated periodically
    -- when each file is read from the source and sent over the network.
    --
    -- If failures occur during a transfer, this value can be less than
    -- @EstimatedFilesToTransfer@. In some cases, this value can also be
    -- greater than @EstimatedFilesToTransfer@. This element is
    -- implementation-specific for some location types, so don\'t use it as an
    -- indicator for a correct file number or to monitor your task execution.
    DescribeTaskExecutionResponse -> Maybe Integer
filesTransferred :: Prelude.Maybe Prelude.Integer,
    -- | 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>.
    DescribeTaskExecutionResponse -> Maybe [FilterRule]
includes :: Prelude.Maybe [FilterRule],
    DescribeTaskExecutionResponse -> Maybe Options
options :: Prelude.Maybe Options,
    -- | The result of the task execution.
    DescribeTaskExecutionResponse -> Maybe TaskExecutionResultDetail
result :: Prelude.Maybe TaskExecutionResultDetail,
    -- | The time that the task execution was started.
    DescribeTaskExecutionResponse -> Maybe POSIX
startTime :: Prelude.Maybe Data.POSIX,
    -- | The status of the task execution.
    --
    -- For detailed information about task execution statuses, see
    -- Understanding Task Statuses in the /DataSync User Guide./
    DescribeTaskExecutionResponse -> Maybe TaskExecutionStatus
status :: Prelude.Maybe TaskExecutionStatus,
    -- | The Amazon Resource Name (ARN) of the task execution that was described.
    -- @TaskExecutionArn@ is hierarchical and includes @TaskArn@ for the task
    -- that was executed.
    --
    -- For example, a @TaskExecution@ value with the ARN
    -- @arn:aws:datasync:us-east-1:111222333444:task\/task-0208075f79cedf4a2\/execution\/exec-08ef1e88ec491019b@
    -- executed the task with the ARN
    -- @arn:aws:datasync:us-east-1:111222333444:task\/task-0208075f79cedf4a2@.
    DescribeTaskExecutionResponse -> Maybe Text
taskExecutionArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeTaskExecutionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeTaskExecutionResponse
-> DescribeTaskExecutionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeTaskExecutionResponse
-> DescribeTaskExecutionResponse -> Bool
$c/= :: DescribeTaskExecutionResponse
-> DescribeTaskExecutionResponse -> Bool
== :: DescribeTaskExecutionResponse
-> DescribeTaskExecutionResponse -> Bool
$c== :: DescribeTaskExecutionResponse
-> DescribeTaskExecutionResponse -> Bool
Prelude.Eq, ReadPrec [DescribeTaskExecutionResponse]
ReadPrec DescribeTaskExecutionResponse
Int -> ReadS DescribeTaskExecutionResponse
ReadS [DescribeTaskExecutionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeTaskExecutionResponse]
$creadListPrec :: ReadPrec [DescribeTaskExecutionResponse]
readPrec :: ReadPrec DescribeTaskExecutionResponse
$creadPrec :: ReadPrec DescribeTaskExecutionResponse
readList :: ReadS [DescribeTaskExecutionResponse]
$creadList :: ReadS [DescribeTaskExecutionResponse]
readsPrec :: Int -> ReadS DescribeTaskExecutionResponse
$creadsPrec :: Int -> ReadS DescribeTaskExecutionResponse
Prelude.Read, Int -> DescribeTaskExecutionResponse -> ShowS
[DescribeTaskExecutionResponse] -> ShowS
DescribeTaskExecutionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeTaskExecutionResponse] -> ShowS
$cshowList :: [DescribeTaskExecutionResponse] -> ShowS
show :: DescribeTaskExecutionResponse -> String
$cshow :: DescribeTaskExecutionResponse -> String
showsPrec :: Int -> DescribeTaskExecutionResponse -> ShowS
$cshowsPrec :: Int -> DescribeTaskExecutionResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeTaskExecutionResponse x
-> DescribeTaskExecutionResponse
forall x.
DescribeTaskExecutionResponse
-> Rep DescribeTaskExecutionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeTaskExecutionResponse x
-> DescribeTaskExecutionResponse
$cfrom :: forall x.
DescribeTaskExecutionResponse
-> Rep DescribeTaskExecutionResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeTaskExecutionResponse' 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:
--
-- 'bytesCompressed', 'describeTaskExecutionResponse_bytesCompressed' - The physical number of bytes transferred over the network after
-- compression was applied. In most cases, this number is less than
-- @BytesTransferred@ unless the data isn\'t compressible.
--
-- 'bytesTransferred', 'describeTaskExecutionResponse_bytesTransferred' - The total number of bytes that are involved in the transfer. For the
-- number of bytes sent over the network, see @BytesCompressed@.
--
-- 'bytesWritten', 'describeTaskExecutionResponse_bytesWritten' - The number of logical bytes written to the destination Amazon Web
-- Services storage resource.
--
-- 'estimatedBytesToTransfer', 'describeTaskExecutionResponse_estimatedBytesToTransfer' - The estimated physical number of bytes that is to be transferred over
-- the network.
--
-- 'estimatedFilesToTransfer', 'describeTaskExecutionResponse_estimatedFilesToTransfer' - The expected number of files that is to be transferred over the network.
-- This value is calculated during the @PREPARING@ phase before the
-- @TRANSFERRING@ phase of the task execution. This value is the expected
-- number of files to be transferred. It\'s calculated based on comparing
-- the content of the source and destination locations and finding the
-- delta that needs to be transferred.
--
-- 'excludes', 'describeTaskExecutionResponse_excludes' - 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>.
--
-- 'filesTransferred', 'describeTaskExecutionResponse_filesTransferred' - The actual number of files that was transferred over the network. This
-- value is calculated and updated on an ongoing basis during the
-- @TRANSFERRING@ phase of the task execution. It\'s updated periodically
-- when each file is read from the source and sent over the network.
--
-- If failures occur during a transfer, this value can be less than
-- @EstimatedFilesToTransfer@. In some cases, this value can also be
-- greater than @EstimatedFilesToTransfer@. This element is
-- implementation-specific for some location types, so don\'t use it as an
-- indicator for a correct file number or to monitor your task execution.
--
-- 'includes', 'describeTaskExecutionResponse_includes' - 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>.
--
-- 'options', 'describeTaskExecutionResponse_options' - Undocumented member.
--
-- 'result', 'describeTaskExecutionResponse_result' - The result of the task execution.
--
-- 'startTime', 'describeTaskExecutionResponse_startTime' - The time that the task execution was started.
--
-- 'status', 'describeTaskExecutionResponse_status' - The status of the task execution.
--
-- For detailed information about task execution statuses, see
-- Understanding Task Statuses in the /DataSync User Guide./
--
-- 'taskExecutionArn', 'describeTaskExecutionResponse_taskExecutionArn' - The Amazon Resource Name (ARN) of the task execution that was described.
-- @TaskExecutionArn@ is hierarchical and includes @TaskArn@ for the task
-- that was executed.
--
-- For example, a @TaskExecution@ value with the ARN
-- @arn:aws:datasync:us-east-1:111222333444:task\/task-0208075f79cedf4a2\/execution\/exec-08ef1e88ec491019b@
-- executed the task with the ARN
-- @arn:aws:datasync:us-east-1:111222333444:task\/task-0208075f79cedf4a2@.
--
-- 'httpStatus', 'describeTaskExecutionResponse_httpStatus' - The response's http status code.
newDescribeTaskExecutionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeTaskExecutionResponse
newDescribeTaskExecutionResponse :: Int -> DescribeTaskExecutionResponse
newDescribeTaskExecutionResponse Int
pHttpStatus_ =
  DescribeTaskExecutionResponse'
    { $sel:bytesCompressed:DescribeTaskExecutionResponse' :: Maybe Integer
bytesCompressed =
        forall a. Maybe a
Prelude.Nothing,
      $sel:bytesTransferred:DescribeTaskExecutionResponse' :: Maybe Integer
bytesTransferred = forall a. Maybe a
Prelude.Nothing,
      $sel:bytesWritten:DescribeTaskExecutionResponse' :: Maybe Integer
bytesWritten = forall a. Maybe a
Prelude.Nothing,
      $sel:estimatedBytesToTransfer:DescribeTaskExecutionResponse' :: Maybe Integer
estimatedBytesToTransfer = forall a. Maybe a
Prelude.Nothing,
      $sel:estimatedFilesToTransfer:DescribeTaskExecutionResponse' :: Maybe Integer
estimatedFilesToTransfer = forall a. Maybe a
Prelude.Nothing,
      $sel:excludes:DescribeTaskExecutionResponse' :: Maybe [FilterRule]
excludes = forall a. Maybe a
Prelude.Nothing,
      $sel:filesTransferred:DescribeTaskExecutionResponse' :: Maybe Integer
filesTransferred = forall a. Maybe a
Prelude.Nothing,
      $sel:includes:DescribeTaskExecutionResponse' :: Maybe [FilterRule]
includes = forall a. Maybe a
Prelude.Nothing,
      $sel:options:DescribeTaskExecutionResponse' :: Maybe Options
options = forall a. Maybe a
Prelude.Nothing,
      $sel:result:DescribeTaskExecutionResponse' :: Maybe TaskExecutionResultDetail
result = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:DescribeTaskExecutionResponse' :: Maybe POSIX
startTime = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DescribeTaskExecutionResponse' :: Maybe TaskExecutionStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:taskExecutionArn:DescribeTaskExecutionResponse' :: Maybe Text
taskExecutionArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeTaskExecutionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The physical number of bytes transferred over the network after
-- compression was applied. In most cases, this number is less than
-- @BytesTransferred@ unless the data isn\'t compressible.
describeTaskExecutionResponse_bytesCompressed :: Lens.Lens' DescribeTaskExecutionResponse (Prelude.Maybe Prelude.Integer)
describeTaskExecutionResponse_bytesCompressed :: Lens' DescribeTaskExecutionResponse (Maybe Integer)
describeTaskExecutionResponse_bytesCompressed = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecutionResponse' {Maybe Integer
bytesCompressed :: Maybe Integer
$sel:bytesCompressed:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Integer
bytesCompressed} -> Maybe Integer
bytesCompressed) (\s :: DescribeTaskExecutionResponse
s@DescribeTaskExecutionResponse' {} Maybe Integer
a -> DescribeTaskExecutionResponse
s {$sel:bytesCompressed:DescribeTaskExecutionResponse' :: Maybe Integer
bytesCompressed = Maybe Integer
a} :: DescribeTaskExecutionResponse)

-- | The total number of bytes that are involved in the transfer. For the
-- number of bytes sent over the network, see @BytesCompressed@.
describeTaskExecutionResponse_bytesTransferred :: Lens.Lens' DescribeTaskExecutionResponse (Prelude.Maybe Prelude.Integer)
describeTaskExecutionResponse_bytesTransferred :: Lens' DescribeTaskExecutionResponse (Maybe Integer)
describeTaskExecutionResponse_bytesTransferred = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecutionResponse' {Maybe Integer
bytesTransferred :: Maybe Integer
$sel:bytesTransferred:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Integer
bytesTransferred} -> Maybe Integer
bytesTransferred) (\s :: DescribeTaskExecutionResponse
s@DescribeTaskExecutionResponse' {} Maybe Integer
a -> DescribeTaskExecutionResponse
s {$sel:bytesTransferred:DescribeTaskExecutionResponse' :: Maybe Integer
bytesTransferred = Maybe Integer
a} :: DescribeTaskExecutionResponse)

-- | The number of logical bytes written to the destination Amazon Web
-- Services storage resource.
describeTaskExecutionResponse_bytesWritten :: Lens.Lens' DescribeTaskExecutionResponse (Prelude.Maybe Prelude.Integer)
describeTaskExecutionResponse_bytesWritten :: Lens' DescribeTaskExecutionResponse (Maybe Integer)
describeTaskExecutionResponse_bytesWritten = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecutionResponse' {Maybe Integer
bytesWritten :: Maybe Integer
$sel:bytesWritten:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Integer
bytesWritten} -> Maybe Integer
bytesWritten) (\s :: DescribeTaskExecutionResponse
s@DescribeTaskExecutionResponse' {} Maybe Integer
a -> DescribeTaskExecutionResponse
s {$sel:bytesWritten:DescribeTaskExecutionResponse' :: Maybe Integer
bytesWritten = Maybe Integer
a} :: DescribeTaskExecutionResponse)

-- | The estimated physical number of bytes that is to be transferred over
-- the network.
describeTaskExecutionResponse_estimatedBytesToTransfer :: Lens.Lens' DescribeTaskExecutionResponse (Prelude.Maybe Prelude.Integer)
describeTaskExecutionResponse_estimatedBytesToTransfer :: Lens' DescribeTaskExecutionResponse (Maybe Integer)
describeTaskExecutionResponse_estimatedBytesToTransfer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecutionResponse' {Maybe Integer
estimatedBytesToTransfer :: Maybe Integer
$sel:estimatedBytesToTransfer:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Integer
estimatedBytesToTransfer} -> Maybe Integer
estimatedBytesToTransfer) (\s :: DescribeTaskExecutionResponse
s@DescribeTaskExecutionResponse' {} Maybe Integer
a -> DescribeTaskExecutionResponse
s {$sel:estimatedBytesToTransfer:DescribeTaskExecutionResponse' :: Maybe Integer
estimatedBytesToTransfer = Maybe Integer
a} :: DescribeTaskExecutionResponse)

-- | The expected number of files that is to be transferred over the network.
-- This value is calculated during the @PREPARING@ phase before the
-- @TRANSFERRING@ phase of the task execution. This value is the expected
-- number of files to be transferred. It\'s calculated based on comparing
-- the content of the source and destination locations and finding the
-- delta that needs to be transferred.
describeTaskExecutionResponse_estimatedFilesToTransfer :: Lens.Lens' DescribeTaskExecutionResponse (Prelude.Maybe Prelude.Integer)
describeTaskExecutionResponse_estimatedFilesToTransfer :: Lens' DescribeTaskExecutionResponse (Maybe Integer)
describeTaskExecutionResponse_estimatedFilesToTransfer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecutionResponse' {Maybe Integer
estimatedFilesToTransfer :: Maybe Integer
$sel:estimatedFilesToTransfer:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Integer
estimatedFilesToTransfer} -> Maybe Integer
estimatedFilesToTransfer) (\s :: DescribeTaskExecutionResponse
s@DescribeTaskExecutionResponse' {} Maybe Integer
a -> DescribeTaskExecutionResponse
s {$sel:estimatedFilesToTransfer:DescribeTaskExecutionResponse' :: Maybe Integer
estimatedFilesToTransfer = Maybe Integer
a} :: DescribeTaskExecutionResponse)

-- | 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>.
describeTaskExecutionResponse_excludes :: Lens.Lens' DescribeTaskExecutionResponse (Prelude.Maybe [FilterRule])
describeTaskExecutionResponse_excludes :: Lens' DescribeTaskExecutionResponse (Maybe [FilterRule])
describeTaskExecutionResponse_excludes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecutionResponse' {Maybe [FilterRule]
excludes :: Maybe [FilterRule]
$sel:excludes:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe [FilterRule]
excludes} -> Maybe [FilterRule]
excludes) (\s :: DescribeTaskExecutionResponse
s@DescribeTaskExecutionResponse' {} Maybe [FilterRule]
a -> DescribeTaskExecutionResponse
s {$sel:excludes:DescribeTaskExecutionResponse' :: Maybe [FilterRule]
excludes = Maybe [FilterRule]
a} :: DescribeTaskExecutionResponse) 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 actual number of files that was transferred over the network. This
-- value is calculated and updated on an ongoing basis during the
-- @TRANSFERRING@ phase of the task execution. It\'s updated periodically
-- when each file is read from the source and sent over the network.
--
-- If failures occur during a transfer, this value can be less than
-- @EstimatedFilesToTransfer@. In some cases, this value can also be
-- greater than @EstimatedFilesToTransfer@. This element is
-- implementation-specific for some location types, so don\'t use it as an
-- indicator for a correct file number or to monitor your task execution.
describeTaskExecutionResponse_filesTransferred :: Lens.Lens' DescribeTaskExecutionResponse (Prelude.Maybe Prelude.Integer)
describeTaskExecutionResponse_filesTransferred :: Lens' DescribeTaskExecutionResponse (Maybe Integer)
describeTaskExecutionResponse_filesTransferred = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecutionResponse' {Maybe Integer
filesTransferred :: Maybe Integer
$sel:filesTransferred:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Integer
filesTransferred} -> Maybe Integer
filesTransferred) (\s :: DescribeTaskExecutionResponse
s@DescribeTaskExecutionResponse' {} Maybe Integer
a -> DescribeTaskExecutionResponse
s {$sel:filesTransferred:DescribeTaskExecutionResponse' :: Maybe Integer
filesTransferred = Maybe Integer
a} :: DescribeTaskExecutionResponse)

-- | 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>.
describeTaskExecutionResponse_includes :: Lens.Lens' DescribeTaskExecutionResponse (Prelude.Maybe [FilterRule])
describeTaskExecutionResponse_includes :: Lens' DescribeTaskExecutionResponse (Maybe [FilterRule])
describeTaskExecutionResponse_includes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecutionResponse' {Maybe [FilterRule]
includes :: Maybe [FilterRule]
$sel:includes:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe [FilterRule]
includes} -> Maybe [FilterRule]
includes) (\s :: DescribeTaskExecutionResponse
s@DescribeTaskExecutionResponse' {} Maybe [FilterRule]
a -> DescribeTaskExecutionResponse
s {$sel:includes:DescribeTaskExecutionResponse' :: Maybe [FilterRule]
includes = Maybe [FilterRule]
a} :: DescribeTaskExecutionResponse) 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.
describeTaskExecutionResponse_options :: Lens.Lens' DescribeTaskExecutionResponse (Prelude.Maybe Options)
describeTaskExecutionResponse_options :: Lens' DescribeTaskExecutionResponse (Maybe Options)
describeTaskExecutionResponse_options = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecutionResponse' {Maybe Options
options :: Maybe Options
$sel:options:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Options
options} -> Maybe Options
options) (\s :: DescribeTaskExecutionResponse
s@DescribeTaskExecutionResponse' {} Maybe Options
a -> DescribeTaskExecutionResponse
s {$sel:options:DescribeTaskExecutionResponse' :: Maybe Options
options = Maybe Options
a} :: DescribeTaskExecutionResponse)

-- | The result of the task execution.
describeTaskExecutionResponse_result :: Lens.Lens' DescribeTaskExecutionResponse (Prelude.Maybe TaskExecutionResultDetail)
describeTaskExecutionResponse_result :: Lens'
  DescribeTaskExecutionResponse (Maybe TaskExecutionResultDetail)
describeTaskExecutionResponse_result = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecutionResponse' {Maybe TaskExecutionResultDetail
result :: Maybe TaskExecutionResultDetail
$sel:result:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe TaskExecutionResultDetail
result} -> Maybe TaskExecutionResultDetail
result) (\s :: DescribeTaskExecutionResponse
s@DescribeTaskExecutionResponse' {} Maybe TaskExecutionResultDetail
a -> DescribeTaskExecutionResponse
s {$sel:result:DescribeTaskExecutionResponse' :: Maybe TaskExecutionResultDetail
result = Maybe TaskExecutionResultDetail
a} :: DescribeTaskExecutionResponse)

-- | The time that the task execution was started.
describeTaskExecutionResponse_startTime :: Lens.Lens' DescribeTaskExecutionResponse (Prelude.Maybe Prelude.UTCTime)
describeTaskExecutionResponse_startTime :: Lens' DescribeTaskExecutionResponse (Maybe UTCTime)
describeTaskExecutionResponse_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecutionResponse' {Maybe POSIX
startTime :: Maybe POSIX
$sel:startTime:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe POSIX
startTime} -> Maybe POSIX
startTime) (\s :: DescribeTaskExecutionResponse
s@DescribeTaskExecutionResponse' {} Maybe POSIX
a -> DescribeTaskExecutionResponse
s {$sel:startTime:DescribeTaskExecutionResponse' :: Maybe POSIX
startTime = Maybe POSIX
a} :: DescribeTaskExecutionResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The status of the task execution.
--
-- For detailed information about task execution statuses, see
-- Understanding Task Statuses in the /DataSync User Guide./
describeTaskExecutionResponse_status :: Lens.Lens' DescribeTaskExecutionResponse (Prelude.Maybe TaskExecutionStatus)
describeTaskExecutionResponse_status :: Lens' DescribeTaskExecutionResponse (Maybe TaskExecutionStatus)
describeTaskExecutionResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecutionResponse' {Maybe TaskExecutionStatus
status :: Maybe TaskExecutionStatus
$sel:status:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe TaskExecutionStatus
status} -> Maybe TaskExecutionStatus
status) (\s :: DescribeTaskExecutionResponse
s@DescribeTaskExecutionResponse' {} Maybe TaskExecutionStatus
a -> DescribeTaskExecutionResponse
s {$sel:status:DescribeTaskExecutionResponse' :: Maybe TaskExecutionStatus
status = Maybe TaskExecutionStatus
a} :: DescribeTaskExecutionResponse)

-- | The Amazon Resource Name (ARN) of the task execution that was described.
-- @TaskExecutionArn@ is hierarchical and includes @TaskArn@ for the task
-- that was executed.
--
-- For example, a @TaskExecution@ value with the ARN
-- @arn:aws:datasync:us-east-1:111222333444:task\/task-0208075f79cedf4a2\/execution\/exec-08ef1e88ec491019b@
-- executed the task with the ARN
-- @arn:aws:datasync:us-east-1:111222333444:task\/task-0208075f79cedf4a2@.
describeTaskExecutionResponse_taskExecutionArn :: Lens.Lens' DescribeTaskExecutionResponse (Prelude.Maybe Prelude.Text)
describeTaskExecutionResponse_taskExecutionArn :: Lens' DescribeTaskExecutionResponse (Maybe Text)
describeTaskExecutionResponse_taskExecutionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTaskExecutionResponse' {Maybe Text
taskExecutionArn :: Maybe Text
$sel:taskExecutionArn:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Text
taskExecutionArn} -> Maybe Text
taskExecutionArn) (\s :: DescribeTaskExecutionResponse
s@DescribeTaskExecutionResponse' {} Maybe Text
a -> DescribeTaskExecutionResponse
s {$sel:taskExecutionArn:DescribeTaskExecutionResponse' :: Maybe Text
taskExecutionArn = Maybe Text
a} :: DescribeTaskExecutionResponse)

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

instance Prelude.NFData DescribeTaskExecutionResponse where
  rnf :: DescribeTaskExecutionResponse -> ()
rnf DescribeTaskExecutionResponse' {Int
Maybe Integer
Maybe [FilterRule]
Maybe Text
Maybe POSIX
Maybe TaskExecutionResultDetail
Maybe TaskExecutionStatus
Maybe Options
httpStatus :: Int
taskExecutionArn :: Maybe Text
status :: Maybe TaskExecutionStatus
startTime :: Maybe POSIX
result :: Maybe TaskExecutionResultDetail
options :: Maybe Options
includes :: Maybe [FilterRule]
filesTransferred :: Maybe Integer
excludes :: Maybe [FilterRule]
estimatedFilesToTransfer :: Maybe Integer
estimatedBytesToTransfer :: Maybe Integer
bytesWritten :: Maybe Integer
bytesTransferred :: Maybe Integer
bytesCompressed :: Maybe Integer
$sel:httpStatus:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Int
$sel:taskExecutionArn:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Text
$sel:status:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe TaskExecutionStatus
$sel:startTime:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe POSIX
$sel:result:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe TaskExecutionResultDetail
$sel:options:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Options
$sel:includes:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe [FilterRule]
$sel:filesTransferred:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Integer
$sel:excludes:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe [FilterRule]
$sel:estimatedFilesToTransfer:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Integer
$sel:estimatedBytesToTransfer:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Integer
$sel:bytesWritten:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Integer
$sel:bytesTransferred:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Integer
$sel:bytesCompressed:DescribeTaskExecutionResponse' :: DescribeTaskExecutionResponse -> Maybe Integer
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
bytesCompressed
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
bytesTransferred
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
bytesWritten
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
estimatedBytesToTransfer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
estimatedFilesToTransfer
      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 Integer
filesTransferred
      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
options
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TaskExecutionResultDetail
result
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TaskExecutionStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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