{-# 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.MigrationHub.ListMigrationTasks
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists all, or filtered by resource name, migration tasks associated with
-- the user account making this call. This API has the following traits:
--
-- -   Can show a summary list of the most recent migration tasks.
--
-- -   Can show a summary list of migration tasks associated with a given
--     discovered resource.
--
-- -   Lists migration tasks in a paginated interface.
--
-- This operation returns paginated results.
module Amazonka.MigrationHub.ListMigrationTasks
  ( -- * Creating a Request
    ListMigrationTasks (..),
    newListMigrationTasks,

    -- * Request Lenses
    listMigrationTasks_maxResults,
    listMigrationTasks_nextToken,
    listMigrationTasks_resourceName,

    -- * Destructuring the Response
    ListMigrationTasksResponse (..),
    newListMigrationTasksResponse,

    -- * Response Lenses
    listMigrationTasksResponse_migrationTaskSummaryList,
    listMigrationTasksResponse_nextToken,
    listMigrationTasksResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListMigrationTasks' smart constructor.
data ListMigrationTasks = ListMigrationTasks'
  { -- | Value to specify how many results are returned per page.
    ListMigrationTasks -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If a @NextToken@ was returned by a previous call, there are more results
    -- available. To retrieve the next page of results, make the call again
    -- using the returned token in @NextToken@.
    ListMigrationTasks -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Filter migration tasks by discovered resource name.
    ListMigrationTasks -> Maybe Text
resourceName :: Prelude.Maybe Prelude.Text
  }
  deriving (ListMigrationTasks -> ListMigrationTasks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMigrationTasks -> ListMigrationTasks -> Bool
$c/= :: ListMigrationTasks -> ListMigrationTasks -> Bool
== :: ListMigrationTasks -> ListMigrationTasks -> Bool
$c== :: ListMigrationTasks -> ListMigrationTasks -> Bool
Prelude.Eq, ReadPrec [ListMigrationTasks]
ReadPrec ListMigrationTasks
Int -> ReadS ListMigrationTasks
ReadS [ListMigrationTasks]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListMigrationTasks]
$creadListPrec :: ReadPrec [ListMigrationTasks]
readPrec :: ReadPrec ListMigrationTasks
$creadPrec :: ReadPrec ListMigrationTasks
readList :: ReadS [ListMigrationTasks]
$creadList :: ReadS [ListMigrationTasks]
readsPrec :: Int -> ReadS ListMigrationTasks
$creadsPrec :: Int -> ReadS ListMigrationTasks
Prelude.Read, Int -> ListMigrationTasks -> ShowS
[ListMigrationTasks] -> ShowS
ListMigrationTasks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMigrationTasks] -> ShowS
$cshowList :: [ListMigrationTasks] -> ShowS
show :: ListMigrationTasks -> String
$cshow :: ListMigrationTasks -> String
showsPrec :: Int -> ListMigrationTasks -> ShowS
$cshowsPrec :: Int -> ListMigrationTasks -> ShowS
Prelude.Show, forall x. Rep ListMigrationTasks x -> ListMigrationTasks
forall x. ListMigrationTasks -> Rep ListMigrationTasks x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListMigrationTasks x -> ListMigrationTasks
$cfrom :: forall x. ListMigrationTasks -> Rep ListMigrationTasks x
Prelude.Generic)

-- |
-- Create a value of 'ListMigrationTasks' 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', 'listMigrationTasks_maxResults' - Value to specify how many results are returned per page.
--
-- 'nextToken', 'listMigrationTasks_nextToken' - If a @NextToken@ was returned by a previous call, there are more results
-- available. To retrieve the next page of results, make the call again
-- using the returned token in @NextToken@.
--
-- 'resourceName', 'listMigrationTasks_resourceName' - Filter migration tasks by discovered resource name.
newListMigrationTasks ::
  ListMigrationTasks
newListMigrationTasks :: ListMigrationTasks
newListMigrationTasks =
  ListMigrationTasks'
    { $sel:maxResults:ListMigrationTasks' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListMigrationTasks' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceName:ListMigrationTasks' :: Maybe Text
resourceName = forall a. Maybe a
Prelude.Nothing
    }

-- | Value to specify how many results are returned per page.
listMigrationTasks_maxResults :: Lens.Lens' ListMigrationTasks (Prelude.Maybe Prelude.Natural)
listMigrationTasks_maxResults :: Lens' ListMigrationTasks (Maybe Natural)
listMigrationTasks_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMigrationTasks' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListMigrationTasks' :: ListMigrationTasks -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListMigrationTasks
s@ListMigrationTasks' {} Maybe Natural
a -> ListMigrationTasks
s {$sel:maxResults:ListMigrationTasks' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListMigrationTasks)

-- | If a @NextToken@ was returned by a previous call, there are more results
-- available. To retrieve the next page of results, make the call again
-- using the returned token in @NextToken@.
listMigrationTasks_nextToken :: Lens.Lens' ListMigrationTasks (Prelude.Maybe Prelude.Text)
listMigrationTasks_nextToken :: Lens' ListMigrationTasks (Maybe Text)
listMigrationTasks_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMigrationTasks' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListMigrationTasks' :: ListMigrationTasks -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListMigrationTasks
s@ListMigrationTasks' {} Maybe Text
a -> ListMigrationTasks
s {$sel:nextToken:ListMigrationTasks' :: Maybe Text
nextToken = Maybe Text
a} :: ListMigrationTasks)

-- | Filter migration tasks by discovered resource name.
listMigrationTasks_resourceName :: Lens.Lens' ListMigrationTasks (Prelude.Maybe Prelude.Text)
listMigrationTasks_resourceName :: Lens' ListMigrationTasks (Maybe Text)
listMigrationTasks_resourceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMigrationTasks' {Maybe Text
resourceName :: Maybe Text
$sel:resourceName:ListMigrationTasks' :: ListMigrationTasks -> Maybe Text
resourceName} -> Maybe Text
resourceName) (\s :: ListMigrationTasks
s@ListMigrationTasks' {} Maybe Text
a -> ListMigrationTasks
s {$sel:resourceName:ListMigrationTasks' :: Maybe Text
resourceName = Maybe Text
a} :: ListMigrationTasks)

instance Core.AWSPager ListMigrationTasks where
  page :: ListMigrationTasks
-> AWSResponse ListMigrationTasks -> Maybe ListMigrationTasks
page ListMigrationTasks
rq AWSResponse ListMigrationTasks
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListMigrationTasks
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMigrationTasksResponse (Maybe Text)
listMigrationTasksResponse_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 ListMigrationTasks
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMigrationTasksResponse (Maybe [MigrationTaskSummary])
listMigrationTasksResponse_migrationTaskSummaryList
            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.$ ListMigrationTasks
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListMigrationTasks (Maybe Text)
listMigrationTasks_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListMigrationTasks
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMigrationTasksResponse (Maybe Text)
listMigrationTasksResponse_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 ListMigrationTasks where
  type
    AWSResponse ListMigrationTasks =
      ListMigrationTasksResponse
  request :: (Service -> Service)
-> ListMigrationTasks -> Request ListMigrationTasks
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 ListMigrationTasks
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListMigrationTasks)))
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 [MigrationTaskSummary]
-> Maybe Text -> Int -> ListMigrationTasksResponse
ListMigrationTasksResponse'
            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
"MigrationTaskSummaryList"
                            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
"NextToken")
            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 ListMigrationTasks where
  hashWithSalt :: Int -> ListMigrationTasks -> Int
hashWithSalt Int
_salt ListMigrationTasks' {Maybe Natural
Maybe Text
resourceName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:resourceName:ListMigrationTasks' :: ListMigrationTasks -> Maybe Text
$sel:nextToken:ListMigrationTasks' :: ListMigrationTasks -> Maybe Text
$sel:maxResults:ListMigrationTasks' :: ListMigrationTasks -> 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
resourceName

instance Prelude.NFData ListMigrationTasks where
  rnf :: ListMigrationTasks -> ()
rnf ListMigrationTasks' {Maybe Natural
Maybe Text
resourceName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:resourceName:ListMigrationTasks' :: ListMigrationTasks -> Maybe Text
$sel:nextToken:ListMigrationTasks' :: ListMigrationTasks -> Maybe Text
$sel:maxResults:ListMigrationTasks' :: ListMigrationTasks -> 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
resourceName

instance Data.ToHeaders ListMigrationTasks where
  toHeaders :: ListMigrationTasks -> 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
"AWSMigrationHub.ListMigrationTasks" ::
                          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 ListMigrationTasks where
  toJSON :: ListMigrationTasks -> Value
toJSON ListMigrationTasks' {Maybe Natural
Maybe Text
resourceName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:resourceName:ListMigrationTasks' :: ListMigrationTasks -> Maybe Text
$sel:nextToken:ListMigrationTasks' :: ListMigrationTasks -> Maybe Text
$sel:maxResults:ListMigrationTasks' :: ListMigrationTasks -> 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
"ResourceName" 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
resourceName
          ]
      )

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

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

-- | /See:/ 'newListMigrationTasksResponse' smart constructor.
data ListMigrationTasksResponse = ListMigrationTasksResponse'
  { -- | Lists the migration task\'s summary which includes: @MigrationTaskName@,
    -- @ProgressPercent@, @ProgressUpdateStream@, @Status@, and the
    -- @UpdateDateTime@ for each task.
    ListMigrationTasksResponse -> Maybe [MigrationTaskSummary]
migrationTaskSummaryList :: Prelude.Maybe [MigrationTaskSummary],
    -- | If there are more migration tasks than the max result, return the next
    -- token to be passed to the next call as a bookmark of where to start
    -- from.
    ListMigrationTasksResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListMigrationTasksResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListMigrationTasksResponse -> ListMigrationTasksResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMigrationTasksResponse -> ListMigrationTasksResponse -> Bool
$c/= :: ListMigrationTasksResponse -> ListMigrationTasksResponse -> Bool
== :: ListMigrationTasksResponse -> ListMigrationTasksResponse -> Bool
$c== :: ListMigrationTasksResponse -> ListMigrationTasksResponse -> Bool
Prelude.Eq, ReadPrec [ListMigrationTasksResponse]
ReadPrec ListMigrationTasksResponse
Int -> ReadS ListMigrationTasksResponse
ReadS [ListMigrationTasksResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListMigrationTasksResponse]
$creadListPrec :: ReadPrec [ListMigrationTasksResponse]
readPrec :: ReadPrec ListMigrationTasksResponse
$creadPrec :: ReadPrec ListMigrationTasksResponse
readList :: ReadS [ListMigrationTasksResponse]
$creadList :: ReadS [ListMigrationTasksResponse]
readsPrec :: Int -> ReadS ListMigrationTasksResponse
$creadsPrec :: Int -> ReadS ListMigrationTasksResponse
Prelude.Read, Int -> ListMigrationTasksResponse -> ShowS
[ListMigrationTasksResponse] -> ShowS
ListMigrationTasksResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMigrationTasksResponse] -> ShowS
$cshowList :: [ListMigrationTasksResponse] -> ShowS
show :: ListMigrationTasksResponse -> String
$cshow :: ListMigrationTasksResponse -> String
showsPrec :: Int -> ListMigrationTasksResponse -> ShowS
$cshowsPrec :: Int -> ListMigrationTasksResponse -> ShowS
Prelude.Show, forall x.
Rep ListMigrationTasksResponse x -> ListMigrationTasksResponse
forall x.
ListMigrationTasksResponse -> Rep ListMigrationTasksResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListMigrationTasksResponse x -> ListMigrationTasksResponse
$cfrom :: forall x.
ListMigrationTasksResponse -> Rep ListMigrationTasksResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListMigrationTasksResponse' 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:
--
-- 'migrationTaskSummaryList', 'listMigrationTasksResponse_migrationTaskSummaryList' - Lists the migration task\'s summary which includes: @MigrationTaskName@,
-- @ProgressPercent@, @ProgressUpdateStream@, @Status@, and the
-- @UpdateDateTime@ for each task.
--
-- 'nextToken', 'listMigrationTasksResponse_nextToken' - If there are more migration tasks than the max result, return the next
-- token to be passed to the next call as a bookmark of where to start
-- from.
--
-- 'httpStatus', 'listMigrationTasksResponse_httpStatus' - The response's http status code.
newListMigrationTasksResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListMigrationTasksResponse
newListMigrationTasksResponse :: Int -> ListMigrationTasksResponse
newListMigrationTasksResponse Int
pHttpStatus_ =
  ListMigrationTasksResponse'
    { $sel:migrationTaskSummaryList:ListMigrationTasksResponse' :: Maybe [MigrationTaskSummary]
migrationTaskSummaryList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListMigrationTasksResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListMigrationTasksResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Lists the migration task\'s summary which includes: @MigrationTaskName@,
-- @ProgressPercent@, @ProgressUpdateStream@, @Status@, and the
-- @UpdateDateTime@ for each task.
listMigrationTasksResponse_migrationTaskSummaryList :: Lens.Lens' ListMigrationTasksResponse (Prelude.Maybe [MigrationTaskSummary])
listMigrationTasksResponse_migrationTaskSummaryList :: Lens' ListMigrationTasksResponse (Maybe [MigrationTaskSummary])
listMigrationTasksResponse_migrationTaskSummaryList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMigrationTasksResponse' {Maybe [MigrationTaskSummary]
migrationTaskSummaryList :: Maybe [MigrationTaskSummary]
$sel:migrationTaskSummaryList:ListMigrationTasksResponse' :: ListMigrationTasksResponse -> Maybe [MigrationTaskSummary]
migrationTaskSummaryList} -> Maybe [MigrationTaskSummary]
migrationTaskSummaryList) (\s :: ListMigrationTasksResponse
s@ListMigrationTasksResponse' {} Maybe [MigrationTaskSummary]
a -> ListMigrationTasksResponse
s {$sel:migrationTaskSummaryList:ListMigrationTasksResponse' :: Maybe [MigrationTaskSummary]
migrationTaskSummaryList = Maybe [MigrationTaskSummary]
a} :: ListMigrationTasksResponse) 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

-- | If there are more migration tasks than the max result, return the next
-- token to be passed to the next call as a bookmark of where to start
-- from.
listMigrationTasksResponse_nextToken :: Lens.Lens' ListMigrationTasksResponse (Prelude.Maybe Prelude.Text)
listMigrationTasksResponse_nextToken :: Lens' ListMigrationTasksResponse (Maybe Text)
listMigrationTasksResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMigrationTasksResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListMigrationTasksResponse' :: ListMigrationTasksResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListMigrationTasksResponse
s@ListMigrationTasksResponse' {} Maybe Text
a -> ListMigrationTasksResponse
s {$sel:nextToken:ListMigrationTasksResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListMigrationTasksResponse)

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

instance Prelude.NFData ListMigrationTasksResponse where
  rnf :: ListMigrationTasksResponse -> ()
rnf ListMigrationTasksResponse' {Int
Maybe [MigrationTaskSummary]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
migrationTaskSummaryList :: Maybe [MigrationTaskSummary]
$sel:httpStatus:ListMigrationTasksResponse' :: ListMigrationTasksResponse -> Int
$sel:nextToken:ListMigrationTasksResponse' :: ListMigrationTasksResponse -> Maybe Text
$sel:migrationTaskSummaryList:ListMigrationTasksResponse' :: ListMigrationTasksResponse -> Maybe [MigrationTaskSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [MigrationTaskSummary]
migrationTaskSummaryList
      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 Int
httpStatus