{-# 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.ListTaskExecutions
-- 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 a list of executed tasks.
--
-- This operation returns paginated results.
module Amazonka.DataSync.ListTaskExecutions
  ( -- * Creating a Request
    ListTaskExecutions (..),
    newListTaskExecutions,

    -- * Request Lenses
    listTaskExecutions_maxResults,
    listTaskExecutions_nextToken,
    listTaskExecutions_taskArn,

    -- * Destructuring the Response
    ListTaskExecutionsResponse (..),
    newListTaskExecutionsResponse,

    -- * Response Lenses
    listTaskExecutionsResponse_nextToken,
    listTaskExecutionsResponse_taskExecutions,
    listTaskExecutionsResponse_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

-- | ListTaskExecutions
--
-- /See:/ 'newListTaskExecutions' smart constructor.
data ListTaskExecutions = ListTaskExecutions'
  { -- | The maximum number of executed tasks to list.
    ListTaskExecutions -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | An opaque string that indicates the position at which to begin the next
    -- list of the executed tasks.
    ListTaskExecutions -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the task whose tasks you want to list.
    ListTaskExecutions -> Maybe Text
taskArn :: Prelude.Maybe Prelude.Text
  }
  deriving (ListTaskExecutions -> ListTaskExecutions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTaskExecutions -> ListTaskExecutions -> Bool
$c/= :: ListTaskExecutions -> ListTaskExecutions -> Bool
== :: ListTaskExecutions -> ListTaskExecutions -> Bool
$c== :: ListTaskExecutions -> ListTaskExecutions -> Bool
Prelude.Eq, ReadPrec [ListTaskExecutions]
ReadPrec ListTaskExecutions
Int -> ReadS ListTaskExecutions
ReadS [ListTaskExecutions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTaskExecutions]
$creadListPrec :: ReadPrec [ListTaskExecutions]
readPrec :: ReadPrec ListTaskExecutions
$creadPrec :: ReadPrec ListTaskExecutions
readList :: ReadS [ListTaskExecutions]
$creadList :: ReadS [ListTaskExecutions]
readsPrec :: Int -> ReadS ListTaskExecutions
$creadsPrec :: Int -> ReadS ListTaskExecutions
Prelude.Read, Int -> ListTaskExecutions -> ShowS
[ListTaskExecutions] -> ShowS
ListTaskExecutions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTaskExecutions] -> ShowS
$cshowList :: [ListTaskExecutions] -> ShowS
show :: ListTaskExecutions -> String
$cshow :: ListTaskExecutions -> String
showsPrec :: Int -> ListTaskExecutions -> ShowS
$cshowsPrec :: Int -> ListTaskExecutions -> ShowS
Prelude.Show, forall x. Rep ListTaskExecutions x -> ListTaskExecutions
forall x. ListTaskExecutions -> Rep ListTaskExecutions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTaskExecutions x -> ListTaskExecutions
$cfrom :: forall x. ListTaskExecutions -> Rep ListTaskExecutions x
Prelude.Generic)

-- |
-- Create a value of 'ListTaskExecutions' 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:
--
-- 'maxResults', 'listTaskExecutions_maxResults' - The maximum number of executed tasks to list.
--
-- 'nextToken', 'listTaskExecutions_nextToken' - An opaque string that indicates the position at which to begin the next
-- list of the executed tasks.
--
-- 'taskArn', 'listTaskExecutions_taskArn' - The Amazon Resource Name (ARN) of the task whose tasks you want to list.
newListTaskExecutions ::
  ListTaskExecutions
newListTaskExecutions :: ListTaskExecutions
newListTaskExecutions =
  ListTaskExecutions'
    { $sel:maxResults:ListTaskExecutions' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListTaskExecutions' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:taskArn:ListTaskExecutions' :: Maybe Text
taskArn = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of executed tasks to list.
listTaskExecutions_maxResults :: Lens.Lens' ListTaskExecutions (Prelude.Maybe Prelude.Natural)
listTaskExecutions_maxResults :: Lens' ListTaskExecutions (Maybe Natural)
listTaskExecutions_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTaskExecutions' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListTaskExecutions' :: ListTaskExecutions -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListTaskExecutions
s@ListTaskExecutions' {} Maybe Natural
a -> ListTaskExecutions
s {$sel:maxResults:ListTaskExecutions' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListTaskExecutions)

-- | An opaque string that indicates the position at which to begin the next
-- list of the executed tasks.
listTaskExecutions_nextToken :: Lens.Lens' ListTaskExecutions (Prelude.Maybe Prelude.Text)
listTaskExecutions_nextToken :: Lens' ListTaskExecutions (Maybe Text)
listTaskExecutions_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTaskExecutions' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTaskExecutions' :: ListTaskExecutions -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTaskExecutions
s@ListTaskExecutions' {} Maybe Text
a -> ListTaskExecutions
s {$sel:nextToken:ListTaskExecutions' :: Maybe Text
nextToken = Maybe Text
a} :: ListTaskExecutions)

-- | The Amazon Resource Name (ARN) of the task whose tasks you want to list.
listTaskExecutions_taskArn :: Lens.Lens' ListTaskExecutions (Prelude.Maybe Prelude.Text)
listTaskExecutions_taskArn :: Lens' ListTaskExecutions (Maybe Text)
listTaskExecutions_taskArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTaskExecutions' {Maybe Text
taskArn :: Maybe Text
$sel:taskArn:ListTaskExecutions' :: ListTaskExecutions -> Maybe Text
taskArn} -> Maybe Text
taskArn) (\s :: ListTaskExecutions
s@ListTaskExecutions' {} Maybe Text
a -> ListTaskExecutions
s {$sel:taskArn:ListTaskExecutions' :: Maybe Text
taskArn = Maybe Text
a} :: ListTaskExecutions)

instance Core.AWSPager ListTaskExecutions where
  page :: ListTaskExecutions
-> AWSResponse ListTaskExecutions -> Maybe ListTaskExecutions
page ListTaskExecutions
rq AWSResponse ListTaskExecutions
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTaskExecutions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTaskExecutionsResponse (Maybe Text)
listTaskExecutionsResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTaskExecutions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTaskExecutionsResponse (Maybe [TaskExecutionListEntry])
listTaskExecutionsResponse_taskExecutions
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListTaskExecutions
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListTaskExecutions (Maybe Text)
listTaskExecutions_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListTaskExecutions
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTaskExecutionsResponse (Maybe Text)
listTaskExecutionsResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListTaskExecutions where
  type
    AWSResponse ListTaskExecutions =
      ListTaskExecutionsResponse
  request :: (Service -> Service)
-> ListTaskExecutions -> Request ListTaskExecutions
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 ListTaskExecutions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListTaskExecutions)))
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
-> Maybe [TaskExecutionListEntry]
-> Int
-> ListTaskExecutionsResponse
ListTaskExecutionsResponse'
            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
"NextToken")
            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
"TaskExecutions" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListTaskExecutions where
  hashWithSalt :: Int -> ListTaskExecutions -> Int
hashWithSalt Int
_salt ListTaskExecutions' {Maybe Natural
Maybe Text
taskArn :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:taskArn:ListTaskExecutions' :: ListTaskExecutions -> Maybe Text
$sel:nextToken:ListTaskExecutions' :: ListTaskExecutions -> Maybe Text
$sel:maxResults:ListTaskExecutions' :: ListTaskExecutions -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
taskArn

instance Prelude.NFData ListTaskExecutions where
  rnf :: ListTaskExecutions -> ()
rnf ListTaskExecutions' {Maybe Natural
Maybe Text
taskArn :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:taskArn:ListTaskExecutions' :: ListTaskExecutions -> Maybe Text
$sel:nextToken:ListTaskExecutions' :: ListTaskExecutions -> Maybe Text
$sel:maxResults:ListTaskExecutions' :: ListTaskExecutions -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
taskArn

instance Data.ToHeaders ListTaskExecutions where
  toHeaders :: ListTaskExecutions -> 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.ListTaskExecutions" ::
                          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 ListTaskExecutions where
  toJSON :: ListTaskExecutions -> Value
toJSON ListTaskExecutions' {Maybe Natural
Maybe Text
taskArn :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:taskArn:ListTaskExecutions' :: ListTaskExecutions -> Maybe Text
$sel:nextToken:ListTaskExecutions' :: ListTaskExecutions -> Maybe Text
$sel:maxResults:ListTaskExecutions' :: ListTaskExecutions -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
maxResults,
            (Key
"NextToken" 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
nextToken,
            (Key
"TaskArn" 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
taskArn
          ]
      )

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

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

-- | ListTaskExecutionsResponse
--
-- /See:/ 'newListTaskExecutionsResponse' smart constructor.
data ListTaskExecutionsResponse = ListTaskExecutionsResponse'
  { -- | An opaque string that indicates the position at which to begin returning
    -- the next list of executed tasks.
    ListTaskExecutionsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A list of executed tasks.
    ListTaskExecutionsResponse -> Maybe [TaskExecutionListEntry]
taskExecutions :: Prelude.Maybe [TaskExecutionListEntry],
    -- | The response's http status code.
    ListTaskExecutionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListTaskExecutionsResponse -> ListTaskExecutionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTaskExecutionsResponse -> ListTaskExecutionsResponse -> Bool
$c/= :: ListTaskExecutionsResponse -> ListTaskExecutionsResponse -> Bool
== :: ListTaskExecutionsResponse -> ListTaskExecutionsResponse -> Bool
$c== :: ListTaskExecutionsResponse -> ListTaskExecutionsResponse -> Bool
Prelude.Eq, ReadPrec [ListTaskExecutionsResponse]
ReadPrec ListTaskExecutionsResponse
Int -> ReadS ListTaskExecutionsResponse
ReadS [ListTaskExecutionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTaskExecutionsResponse]
$creadListPrec :: ReadPrec [ListTaskExecutionsResponse]
readPrec :: ReadPrec ListTaskExecutionsResponse
$creadPrec :: ReadPrec ListTaskExecutionsResponse
readList :: ReadS [ListTaskExecutionsResponse]
$creadList :: ReadS [ListTaskExecutionsResponse]
readsPrec :: Int -> ReadS ListTaskExecutionsResponse
$creadsPrec :: Int -> ReadS ListTaskExecutionsResponse
Prelude.Read, Int -> ListTaskExecutionsResponse -> ShowS
[ListTaskExecutionsResponse] -> ShowS
ListTaskExecutionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTaskExecutionsResponse] -> ShowS
$cshowList :: [ListTaskExecutionsResponse] -> ShowS
show :: ListTaskExecutionsResponse -> String
$cshow :: ListTaskExecutionsResponse -> String
showsPrec :: Int -> ListTaskExecutionsResponse -> ShowS
$cshowsPrec :: Int -> ListTaskExecutionsResponse -> ShowS
Prelude.Show, forall x.
Rep ListTaskExecutionsResponse x -> ListTaskExecutionsResponse
forall x.
ListTaskExecutionsResponse -> Rep ListTaskExecutionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListTaskExecutionsResponse x -> ListTaskExecutionsResponse
$cfrom :: forall x.
ListTaskExecutionsResponse -> Rep ListTaskExecutionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListTaskExecutionsResponse' 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:
--
-- 'nextToken', 'listTaskExecutionsResponse_nextToken' - An opaque string that indicates the position at which to begin returning
-- the next list of executed tasks.
--
-- 'taskExecutions', 'listTaskExecutionsResponse_taskExecutions' - A list of executed tasks.
--
-- 'httpStatus', 'listTaskExecutionsResponse_httpStatus' - The response's http status code.
newListTaskExecutionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListTaskExecutionsResponse
newListTaskExecutionsResponse :: Int -> ListTaskExecutionsResponse
newListTaskExecutionsResponse Int
pHttpStatus_ =
  ListTaskExecutionsResponse'
    { $sel:nextToken:ListTaskExecutionsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:taskExecutions:ListTaskExecutionsResponse' :: Maybe [TaskExecutionListEntry]
taskExecutions = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListTaskExecutionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An opaque string that indicates the position at which to begin returning
-- the next list of executed tasks.
listTaskExecutionsResponse_nextToken :: Lens.Lens' ListTaskExecutionsResponse (Prelude.Maybe Prelude.Text)
listTaskExecutionsResponse_nextToken :: Lens' ListTaskExecutionsResponse (Maybe Text)
listTaskExecutionsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTaskExecutionsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTaskExecutionsResponse' :: ListTaskExecutionsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTaskExecutionsResponse
s@ListTaskExecutionsResponse' {} Maybe Text
a -> ListTaskExecutionsResponse
s {$sel:nextToken:ListTaskExecutionsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListTaskExecutionsResponse)

-- | A list of executed tasks.
listTaskExecutionsResponse_taskExecutions :: Lens.Lens' ListTaskExecutionsResponse (Prelude.Maybe [TaskExecutionListEntry])
listTaskExecutionsResponse_taskExecutions :: Lens' ListTaskExecutionsResponse (Maybe [TaskExecutionListEntry])
listTaskExecutionsResponse_taskExecutions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTaskExecutionsResponse' {Maybe [TaskExecutionListEntry]
taskExecutions :: Maybe [TaskExecutionListEntry]
$sel:taskExecutions:ListTaskExecutionsResponse' :: ListTaskExecutionsResponse -> Maybe [TaskExecutionListEntry]
taskExecutions} -> Maybe [TaskExecutionListEntry]
taskExecutions) (\s :: ListTaskExecutionsResponse
s@ListTaskExecutionsResponse' {} Maybe [TaskExecutionListEntry]
a -> ListTaskExecutionsResponse
s {$sel:taskExecutions:ListTaskExecutionsResponse' :: Maybe [TaskExecutionListEntry]
taskExecutions = Maybe [TaskExecutionListEntry]
a} :: ListTaskExecutionsResponse) 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 response's http status code.
listTaskExecutionsResponse_httpStatus :: Lens.Lens' ListTaskExecutionsResponse Prelude.Int
listTaskExecutionsResponse_httpStatus :: Lens' ListTaskExecutionsResponse Int
listTaskExecutionsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTaskExecutionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListTaskExecutionsResponse' :: ListTaskExecutionsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListTaskExecutionsResponse
s@ListTaskExecutionsResponse' {} Int
a -> ListTaskExecutionsResponse
s {$sel:httpStatus:ListTaskExecutionsResponse' :: Int
httpStatus = Int
a} :: ListTaskExecutionsResponse)

instance Prelude.NFData ListTaskExecutionsResponse where
  rnf :: ListTaskExecutionsResponse -> ()
rnf ListTaskExecutionsResponse' {Int
Maybe [TaskExecutionListEntry]
Maybe Text
httpStatus :: Int
taskExecutions :: Maybe [TaskExecutionListEntry]
nextToken :: Maybe Text
$sel:httpStatus:ListTaskExecutionsResponse' :: ListTaskExecutionsResponse -> Int
$sel:taskExecutions:ListTaskExecutionsResponse' :: ListTaskExecutionsResponse -> Maybe [TaskExecutionListEntry]
$sel:nextToken:ListTaskExecutionsResponse' :: ListTaskExecutionsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TaskExecutionListEntry]
taskExecutions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus