{-# 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.StepFunctions.ListMapRuns
-- 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 Map Runs that were started by a given state machine execution.
-- Use this API action to obtain Map Run ARNs, and then call
-- @DescribeMapRun@ to obtain more information, if needed.
--
-- This operation returns paginated results.
module Amazonka.StepFunctions.ListMapRuns
  ( -- * Creating a Request
    ListMapRuns (..),
    newListMapRuns,

    -- * Request Lenses
    listMapRuns_maxResults,
    listMapRuns_nextToken,
    listMapRuns_executionArn,

    -- * Destructuring the Response
    ListMapRunsResponse (..),
    newListMapRunsResponse,

    -- * Response Lenses
    listMapRunsResponse_nextToken,
    listMapRunsResponse_httpStatus,
    listMapRunsResponse_mapRuns,
  )
where

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

-- | /See:/ 'newListMapRuns' smart constructor.
data ListMapRuns = ListMapRuns'
  { -- | The maximum number of results that are returned per call. You can use
    -- @nextToken@ to obtain further pages of results. The default is 100 and
    -- the maximum allowed page size is 1000. A value of 0 uses the default.
    --
    -- This is only an upper limit. The actual number of results returned per
    -- call might be fewer than the specified maximum.
    ListMapRuns -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If @nextToken@ is returned, there are more results available. The value
    -- of @nextToken@ is a unique pagination token for each page. Make the call
    -- again using the returned token to retrieve the next page. Keep all other
    -- arguments unchanged. Each pagination token expires after 24 hours. Using
    -- an expired pagination token will return an /HTTP 400 InvalidToken/
    -- error.
    ListMapRuns -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the execution for which the Map Runs
    -- must be listed.
    ListMapRuns -> Text
executionArn :: Prelude.Text
  }
  deriving (ListMapRuns -> ListMapRuns -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMapRuns -> ListMapRuns -> Bool
$c/= :: ListMapRuns -> ListMapRuns -> Bool
== :: ListMapRuns -> ListMapRuns -> Bool
$c== :: ListMapRuns -> ListMapRuns -> Bool
Prelude.Eq, ReadPrec [ListMapRuns]
ReadPrec ListMapRuns
Int -> ReadS ListMapRuns
ReadS [ListMapRuns]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListMapRuns]
$creadListPrec :: ReadPrec [ListMapRuns]
readPrec :: ReadPrec ListMapRuns
$creadPrec :: ReadPrec ListMapRuns
readList :: ReadS [ListMapRuns]
$creadList :: ReadS [ListMapRuns]
readsPrec :: Int -> ReadS ListMapRuns
$creadsPrec :: Int -> ReadS ListMapRuns
Prelude.Read, Int -> ListMapRuns -> ShowS
[ListMapRuns] -> ShowS
ListMapRuns -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMapRuns] -> ShowS
$cshowList :: [ListMapRuns] -> ShowS
show :: ListMapRuns -> String
$cshow :: ListMapRuns -> String
showsPrec :: Int -> ListMapRuns -> ShowS
$cshowsPrec :: Int -> ListMapRuns -> ShowS
Prelude.Show, forall x. Rep ListMapRuns x -> ListMapRuns
forall x. ListMapRuns -> Rep ListMapRuns x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListMapRuns x -> ListMapRuns
$cfrom :: forall x. ListMapRuns -> Rep ListMapRuns x
Prelude.Generic)

-- |
-- Create a value of 'ListMapRuns' 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', 'listMapRuns_maxResults' - The maximum number of results that are returned per call. You can use
-- @nextToken@ to obtain further pages of results. The default is 100 and
-- the maximum allowed page size is 1000. A value of 0 uses the default.
--
-- This is only an upper limit. The actual number of results returned per
-- call might be fewer than the specified maximum.
--
-- 'nextToken', 'listMapRuns_nextToken' - If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ is a unique pagination token for each page. Make the call
-- again using the returned token to retrieve the next page. Keep all other
-- arguments unchanged. Each pagination token expires after 24 hours. Using
-- an expired pagination token will return an /HTTP 400 InvalidToken/
-- error.
--
-- 'executionArn', 'listMapRuns_executionArn' - The Amazon Resource Name (ARN) of the execution for which the Map Runs
-- must be listed.
newListMapRuns ::
  -- | 'executionArn'
  Prelude.Text ->
  ListMapRuns
newListMapRuns :: Text -> ListMapRuns
newListMapRuns Text
pExecutionArn_ =
  ListMapRuns'
    { $sel:maxResults:ListMapRuns' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListMapRuns' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:executionArn:ListMapRuns' :: Text
executionArn = Text
pExecutionArn_
    }

-- | The maximum number of results that are returned per call. You can use
-- @nextToken@ to obtain further pages of results. The default is 100 and
-- the maximum allowed page size is 1000. A value of 0 uses the default.
--
-- This is only an upper limit. The actual number of results returned per
-- call might be fewer than the specified maximum.
listMapRuns_maxResults :: Lens.Lens' ListMapRuns (Prelude.Maybe Prelude.Natural)
listMapRuns_maxResults :: Lens' ListMapRuns (Maybe Natural)
listMapRuns_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMapRuns' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListMapRuns' :: ListMapRuns -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListMapRuns
s@ListMapRuns' {} Maybe Natural
a -> ListMapRuns
s {$sel:maxResults:ListMapRuns' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListMapRuns)

-- | If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ is a unique pagination token for each page. Make the call
-- again using the returned token to retrieve the next page. Keep all other
-- arguments unchanged. Each pagination token expires after 24 hours. Using
-- an expired pagination token will return an /HTTP 400 InvalidToken/
-- error.
listMapRuns_nextToken :: Lens.Lens' ListMapRuns (Prelude.Maybe Prelude.Text)
listMapRuns_nextToken :: Lens' ListMapRuns (Maybe Text)
listMapRuns_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMapRuns' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListMapRuns' :: ListMapRuns -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListMapRuns
s@ListMapRuns' {} Maybe Text
a -> ListMapRuns
s {$sel:nextToken:ListMapRuns' :: Maybe Text
nextToken = Maybe Text
a} :: ListMapRuns)

-- | The Amazon Resource Name (ARN) of the execution for which the Map Runs
-- must be listed.
listMapRuns_executionArn :: Lens.Lens' ListMapRuns Prelude.Text
listMapRuns_executionArn :: Lens' ListMapRuns Text
listMapRuns_executionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMapRuns' {Text
executionArn :: Text
$sel:executionArn:ListMapRuns' :: ListMapRuns -> Text
executionArn} -> Text
executionArn) (\s :: ListMapRuns
s@ListMapRuns' {} Text
a -> ListMapRuns
s {$sel:executionArn:ListMapRuns' :: Text
executionArn = Text
a} :: ListMapRuns)

instance Core.AWSPager ListMapRuns where
  page :: ListMapRuns -> AWSResponse ListMapRuns -> Maybe ListMapRuns
page ListMapRuns
rq AWSResponse ListMapRuns
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListMapRuns
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMapRunsResponse (Maybe Text)
listMapRunsResponse_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 ListMapRuns
rs forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListMapRunsResponse [MapRunListItem]
listMapRunsResponse_mapRuns) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListMapRuns
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListMapRuns (Maybe Text)
listMapRuns_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListMapRuns
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMapRunsResponse (Maybe Text)
listMapRunsResponse_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 ListMapRuns where
  type AWSResponse ListMapRuns = ListMapRunsResponse
  request :: (Service -> Service) -> ListMapRuns -> Request ListMapRuns
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 ListMapRuns
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListMapRuns)))
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 -> [MapRunListItem] -> ListMapRunsResponse
ListMapRunsResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            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
"mapRuns" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable ListMapRuns where
  hashWithSalt :: Int -> ListMapRuns -> Int
hashWithSalt Int
_salt ListMapRuns' {Maybe Natural
Maybe Text
Text
executionArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:executionArn:ListMapRuns' :: ListMapRuns -> Text
$sel:nextToken:ListMapRuns' :: ListMapRuns -> Maybe Text
$sel:maxResults:ListMapRuns' :: ListMapRuns -> 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` Text
executionArn

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

instance Data.ToHeaders ListMapRuns where
  toHeaders :: ListMapRuns -> 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
"AWSStepFunctions.ListMapRuns" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListMapRuns where
  toJSON :: ListMapRuns -> Value
toJSON ListMapRuns' {Maybe Natural
Maybe Text
Text
executionArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:executionArn:ListMapRuns' :: ListMapRuns -> Text
$sel:nextToken:ListMapRuns' :: ListMapRuns -> Maybe Text
$sel:maxResults:ListMapRuns' :: ListMapRuns -> 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,
            forall a. a -> Maybe a
Prelude.Just (Key
"executionArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
executionArn)
          ]
      )

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

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

-- | /See:/ 'newListMapRunsResponse' smart constructor.
data ListMapRunsResponse = ListMapRunsResponse'
  { -- | If @nextToken@ is returned, there are more results available. The value
    -- of @nextToken@ is a unique pagination token for each page. Make the call
    -- again using the returned token to retrieve the next page. Keep all other
    -- arguments unchanged. Each pagination token expires after 24 hours. Using
    -- an expired pagination token will return an /HTTP 400 InvalidToken/
    -- error.
    ListMapRunsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListMapRunsResponse -> Int
httpStatus :: Prelude.Int,
    -- | An array that lists information related to a Map Run, such as the Amazon
    -- Resource Name (ARN) of the Map Run and the ARN of the state machine that
    -- started the Map Run.
    ListMapRunsResponse -> [MapRunListItem]
mapRuns :: [MapRunListItem]
  }
  deriving (ListMapRunsResponse -> ListMapRunsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMapRunsResponse -> ListMapRunsResponse -> Bool
$c/= :: ListMapRunsResponse -> ListMapRunsResponse -> Bool
== :: ListMapRunsResponse -> ListMapRunsResponse -> Bool
$c== :: ListMapRunsResponse -> ListMapRunsResponse -> Bool
Prelude.Eq, ReadPrec [ListMapRunsResponse]
ReadPrec ListMapRunsResponse
Int -> ReadS ListMapRunsResponse
ReadS [ListMapRunsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListMapRunsResponse]
$creadListPrec :: ReadPrec [ListMapRunsResponse]
readPrec :: ReadPrec ListMapRunsResponse
$creadPrec :: ReadPrec ListMapRunsResponse
readList :: ReadS [ListMapRunsResponse]
$creadList :: ReadS [ListMapRunsResponse]
readsPrec :: Int -> ReadS ListMapRunsResponse
$creadsPrec :: Int -> ReadS ListMapRunsResponse
Prelude.Read, Int -> ListMapRunsResponse -> ShowS
[ListMapRunsResponse] -> ShowS
ListMapRunsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMapRunsResponse] -> ShowS
$cshowList :: [ListMapRunsResponse] -> ShowS
show :: ListMapRunsResponse -> String
$cshow :: ListMapRunsResponse -> String
showsPrec :: Int -> ListMapRunsResponse -> ShowS
$cshowsPrec :: Int -> ListMapRunsResponse -> ShowS
Prelude.Show, forall x. Rep ListMapRunsResponse x -> ListMapRunsResponse
forall x. ListMapRunsResponse -> Rep ListMapRunsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListMapRunsResponse x -> ListMapRunsResponse
$cfrom :: forall x. ListMapRunsResponse -> Rep ListMapRunsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListMapRunsResponse' 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', 'listMapRunsResponse_nextToken' - If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ is a unique pagination token for each page. Make the call
-- again using the returned token to retrieve the next page. Keep all other
-- arguments unchanged. Each pagination token expires after 24 hours. Using
-- an expired pagination token will return an /HTTP 400 InvalidToken/
-- error.
--
-- 'httpStatus', 'listMapRunsResponse_httpStatus' - The response's http status code.
--
-- 'mapRuns', 'listMapRunsResponse_mapRuns' - An array that lists information related to a Map Run, such as the Amazon
-- Resource Name (ARN) of the Map Run and the ARN of the state machine that
-- started the Map Run.
newListMapRunsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListMapRunsResponse
newListMapRunsResponse :: Int -> ListMapRunsResponse
newListMapRunsResponse Int
pHttpStatus_ =
  ListMapRunsResponse'
    { $sel:nextToken:ListMapRunsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListMapRunsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:mapRuns:ListMapRunsResponse' :: [MapRunListItem]
mapRuns = forall a. Monoid a => a
Prelude.mempty
    }

-- | If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ is a unique pagination token for each page. Make the call
-- again using the returned token to retrieve the next page. Keep all other
-- arguments unchanged. Each pagination token expires after 24 hours. Using
-- an expired pagination token will return an /HTTP 400 InvalidToken/
-- error.
listMapRunsResponse_nextToken :: Lens.Lens' ListMapRunsResponse (Prelude.Maybe Prelude.Text)
listMapRunsResponse_nextToken :: Lens' ListMapRunsResponse (Maybe Text)
listMapRunsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMapRunsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListMapRunsResponse' :: ListMapRunsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListMapRunsResponse
s@ListMapRunsResponse' {} Maybe Text
a -> ListMapRunsResponse
s {$sel:nextToken:ListMapRunsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListMapRunsResponse)

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

-- | An array that lists information related to a Map Run, such as the Amazon
-- Resource Name (ARN) of the Map Run and the ARN of the state machine that
-- started the Map Run.
listMapRunsResponse_mapRuns :: Lens.Lens' ListMapRunsResponse [MapRunListItem]
listMapRunsResponse_mapRuns :: Lens' ListMapRunsResponse [MapRunListItem]
listMapRunsResponse_mapRuns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMapRunsResponse' {[MapRunListItem]
mapRuns :: [MapRunListItem]
$sel:mapRuns:ListMapRunsResponse' :: ListMapRunsResponse -> [MapRunListItem]
mapRuns} -> [MapRunListItem]
mapRuns) (\s :: ListMapRunsResponse
s@ListMapRunsResponse' {} [MapRunListItem]
a -> ListMapRunsResponse
s {$sel:mapRuns:ListMapRunsResponse' :: [MapRunListItem]
mapRuns = [MapRunListItem]
a} :: ListMapRunsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData ListMapRunsResponse where
  rnf :: ListMapRunsResponse -> ()
rnf ListMapRunsResponse' {Int
[MapRunListItem]
Maybe Text
mapRuns :: [MapRunListItem]
httpStatus :: Int
nextToken :: Maybe Text
$sel:mapRuns:ListMapRunsResponse' :: ListMapRunsResponse -> [MapRunListItem]
$sel:httpStatus:ListMapRunsResponse' :: ListMapRunsResponse -> Int
$sel:nextToken:ListMapRunsResponse' :: ListMapRunsResponse -> 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 Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [MapRunListItem]
mapRuns