{-# 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.DescribeMapRun
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides information about a Map Run\'s configuration, progress, and
-- results. For more information, see
-- <https://docs.aws.amazon.com/step-functions/latest/dg/concepts-examine-map-run.html Examining Map Run>
-- in the /Step Functions Developer Guide/.
module Amazonka.StepFunctions.DescribeMapRun
  ( -- * Creating a Request
    DescribeMapRun (..),
    newDescribeMapRun,

    -- * Request Lenses
    describeMapRun_mapRunArn,

    -- * Destructuring the Response
    DescribeMapRunResponse (..),
    newDescribeMapRunResponse,

    -- * Response Lenses
    describeMapRunResponse_stopDate,
    describeMapRunResponse_httpStatus,
    describeMapRunResponse_mapRunArn,
    describeMapRunResponse_executionArn,
    describeMapRunResponse_status,
    describeMapRunResponse_startDate,
    describeMapRunResponse_maxConcurrency,
    describeMapRunResponse_toleratedFailurePercentage,
    describeMapRunResponse_toleratedFailureCount,
    describeMapRunResponse_itemCounts,
    describeMapRunResponse_executionCounts,
  )
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:/ 'newDescribeMapRun' smart constructor.
data DescribeMapRun = DescribeMapRun'
  { -- | The Amazon Resource Name (ARN) that identifies a Map Run.
    DescribeMapRun -> Text
mapRunArn :: Prelude.Text
  }
  deriving (DescribeMapRun -> DescribeMapRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeMapRun -> DescribeMapRun -> Bool
$c/= :: DescribeMapRun -> DescribeMapRun -> Bool
== :: DescribeMapRun -> DescribeMapRun -> Bool
$c== :: DescribeMapRun -> DescribeMapRun -> Bool
Prelude.Eq, ReadPrec [DescribeMapRun]
ReadPrec DescribeMapRun
Int -> ReadS DescribeMapRun
ReadS [DescribeMapRun]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeMapRun]
$creadListPrec :: ReadPrec [DescribeMapRun]
readPrec :: ReadPrec DescribeMapRun
$creadPrec :: ReadPrec DescribeMapRun
readList :: ReadS [DescribeMapRun]
$creadList :: ReadS [DescribeMapRun]
readsPrec :: Int -> ReadS DescribeMapRun
$creadsPrec :: Int -> ReadS DescribeMapRun
Prelude.Read, Int -> DescribeMapRun -> ShowS
[DescribeMapRun] -> ShowS
DescribeMapRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeMapRun] -> ShowS
$cshowList :: [DescribeMapRun] -> ShowS
show :: DescribeMapRun -> String
$cshow :: DescribeMapRun -> String
showsPrec :: Int -> DescribeMapRun -> ShowS
$cshowsPrec :: Int -> DescribeMapRun -> ShowS
Prelude.Show, forall x. Rep DescribeMapRun x -> DescribeMapRun
forall x. DescribeMapRun -> Rep DescribeMapRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeMapRun x -> DescribeMapRun
$cfrom :: forall x. DescribeMapRun -> Rep DescribeMapRun x
Prelude.Generic)

-- |
-- Create a value of 'DescribeMapRun' 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:
--
-- 'mapRunArn', 'describeMapRun_mapRunArn' - The Amazon Resource Name (ARN) that identifies a Map Run.
newDescribeMapRun ::
  -- | 'mapRunArn'
  Prelude.Text ->
  DescribeMapRun
newDescribeMapRun :: Text -> DescribeMapRun
newDescribeMapRun Text
pMapRunArn_ =
  DescribeMapRun' {$sel:mapRunArn:DescribeMapRun' :: Text
mapRunArn = Text
pMapRunArn_}

-- | The Amazon Resource Name (ARN) that identifies a Map Run.
describeMapRun_mapRunArn :: Lens.Lens' DescribeMapRun Prelude.Text
describeMapRun_mapRunArn :: Lens' DescribeMapRun Text
describeMapRun_mapRunArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMapRun' {Text
mapRunArn :: Text
$sel:mapRunArn:DescribeMapRun' :: DescribeMapRun -> Text
mapRunArn} -> Text
mapRunArn) (\s :: DescribeMapRun
s@DescribeMapRun' {} Text
a -> DescribeMapRun
s {$sel:mapRunArn:DescribeMapRun' :: Text
mapRunArn = Text
a} :: DescribeMapRun)

instance Core.AWSRequest DescribeMapRun where
  type
    AWSResponse DescribeMapRun =
      DescribeMapRunResponse
  request :: (Service -> Service) -> DescribeMapRun -> Request DescribeMapRun
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 DescribeMapRun
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeMapRun)))
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 POSIX
-> Int
-> Text
-> Text
-> MapRunStatus
-> POSIX
-> Natural
-> Double
-> Natural
-> MapRunItemCounts
-> MapRunExecutionCounts
-> DescribeMapRunResponse
DescribeMapRunResponse'
            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
"stopDate")
            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 a
Data..:> Key
"mapRunArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"executionArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String 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 a
Data..:> Key
"startDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"maxConcurrency")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"toleratedFailurePercentage")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"toleratedFailureCount")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"itemCounts")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"executionCounts")
      )

instance Prelude.Hashable DescribeMapRun where
  hashWithSalt :: Int -> DescribeMapRun -> Int
hashWithSalt Int
_salt DescribeMapRun' {Text
mapRunArn :: Text
$sel:mapRunArn:DescribeMapRun' :: DescribeMapRun -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
mapRunArn

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

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

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

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

-- | /See:/ 'newDescribeMapRunResponse' smart constructor.
data DescribeMapRunResponse = DescribeMapRunResponse'
  { -- | The date when the Map Run was stopped.
    DescribeMapRunResponse -> Maybe POSIX
stopDate :: Prelude.Maybe Data.POSIX,
    -- | The response's http status code.
    DescribeMapRunResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) that identifies a Map Run.
    DescribeMapRunResponse -> Text
mapRunArn :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) that identifies the execution in which
    -- the Map Run was started.
    DescribeMapRunResponse -> Text
executionArn :: Prelude.Text,
    -- | The current status of the Map Run.
    DescribeMapRunResponse -> MapRunStatus
status :: MapRunStatus,
    -- | The date when the Map Run was started.
    DescribeMapRunResponse -> POSIX
startDate :: Data.POSIX,
    -- | The maximum number of child workflow executions configured to run in
    -- parallel for the Map Run at the same time.
    DescribeMapRunResponse -> Natural
maxConcurrency :: Prelude.Natural,
    -- | The maximum percentage of failed child workflow executions before the
    -- Map Run fails.
    DescribeMapRunResponse -> Double
toleratedFailurePercentage :: Prelude.Double,
    -- | The maximum number of failed child workflow executions before the Map
    -- Run fails.
    DescribeMapRunResponse -> Natural
toleratedFailureCount :: Prelude.Natural,
    -- | A JSON object that contains information about the total number of items,
    -- and the item count for each processing status, such as @pending@ and
    -- @failed@.
    DescribeMapRunResponse -> MapRunItemCounts
itemCounts :: MapRunItemCounts,
    -- | A JSON object that contains information about the total number of child
    -- workflow executions for the Map Run, and the count of child workflow
    -- executions for each status, such as @failed@ and @succeeded@.
    DescribeMapRunResponse -> MapRunExecutionCounts
executionCounts :: MapRunExecutionCounts
  }
  deriving (DescribeMapRunResponse -> DescribeMapRunResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeMapRunResponse -> DescribeMapRunResponse -> Bool
$c/= :: DescribeMapRunResponse -> DescribeMapRunResponse -> Bool
== :: DescribeMapRunResponse -> DescribeMapRunResponse -> Bool
$c== :: DescribeMapRunResponse -> DescribeMapRunResponse -> Bool
Prelude.Eq, ReadPrec [DescribeMapRunResponse]
ReadPrec DescribeMapRunResponse
Int -> ReadS DescribeMapRunResponse
ReadS [DescribeMapRunResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeMapRunResponse]
$creadListPrec :: ReadPrec [DescribeMapRunResponse]
readPrec :: ReadPrec DescribeMapRunResponse
$creadPrec :: ReadPrec DescribeMapRunResponse
readList :: ReadS [DescribeMapRunResponse]
$creadList :: ReadS [DescribeMapRunResponse]
readsPrec :: Int -> ReadS DescribeMapRunResponse
$creadsPrec :: Int -> ReadS DescribeMapRunResponse
Prelude.Read, Int -> DescribeMapRunResponse -> ShowS
[DescribeMapRunResponse] -> ShowS
DescribeMapRunResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeMapRunResponse] -> ShowS
$cshowList :: [DescribeMapRunResponse] -> ShowS
show :: DescribeMapRunResponse -> String
$cshow :: DescribeMapRunResponse -> String
showsPrec :: Int -> DescribeMapRunResponse -> ShowS
$cshowsPrec :: Int -> DescribeMapRunResponse -> ShowS
Prelude.Show, forall x. Rep DescribeMapRunResponse x -> DescribeMapRunResponse
forall x. DescribeMapRunResponse -> Rep DescribeMapRunResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeMapRunResponse x -> DescribeMapRunResponse
$cfrom :: forall x. DescribeMapRunResponse -> Rep DescribeMapRunResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeMapRunResponse' 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:
--
-- 'stopDate', 'describeMapRunResponse_stopDate' - The date when the Map Run was stopped.
--
-- 'httpStatus', 'describeMapRunResponse_httpStatus' - The response's http status code.
--
-- 'mapRunArn', 'describeMapRunResponse_mapRunArn' - The Amazon Resource Name (ARN) that identifies a Map Run.
--
-- 'executionArn', 'describeMapRunResponse_executionArn' - The Amazon Resource Name (ARN) that identifies the execution in which
-- the Map Run was started.
--
-- 'status', 'describeMapRunResponse_status' - The current status of the Map Run.
--
-- 'startDate', 'describeMapRunResponse_startDate' - The date when the Map Run was started.
--
-- 'maxConcurrency', 'describeMapRunResponse_maxConcurrency' - The maximum number of child workflow executions configured to run in
-- parallel for the Map Run at the same time.
--
-- 'toleratedFailurePercentage', 'describeMapRunResponse_toleratedFailurePercentage' - The maximum percentage of failed child workflow executions before the
-- Map Run fails.
--
-- 'toleratedFailureCount', 'describeMapRunResponse_toleratedFailureCount' - The maximum number of failed child workflow executions before the Map
-- Run fails.
--
-- 'itemCounts', 'describeMapRunResponse_itemCounts' - A JSON object that contains information about the total number of items,
-- and the item count for each processing status, such as @pending@ and
-- @failed@.
--
-- 'executionCounts', 'describeMapRunResponse_executionCounts' - A JSON object that contains information about the total number of child
-- workflow executions for the Map Run, and the count of child workflow
-- executions for each status, such as @failed@ and @succeeded@.
newDescribeMapRunResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'mapRunArn'
  Prelude.Text ->
  -- | 'executionArn'
  Prelude.Text ->
  -- | 'status'
  MapRunStatus ->
  -- | 'startDate'
  Prelude.UTCTime ->
  -- | 'maxConcurrency'
  Prelude.Natural ->
  -- | 'toleratedFailurePercentage'
  Prelude.Double ->
  -- | 'toleratedFailureCount'
  Prelude.Natural ->
  -- | 'itemCounts'
  MapRunItemCounts ->
  -- | 'executionCounts'
  MapRunExecutionCounts ->
  DescribeMapRunResponse
newDescribeMapRunResponse :: Int
-> Text
-> Text
-> MapRunStatus
-> UTCTime
-> Natural
-> Double
-> Natural
-> MapRunItemCounts
-> MapRunExecutionCounts
-> DescribeMapRunResponse
newDescribeMapRunResponse
  Int
pHttpStatus_
  Text
pMapRunArn_
  Text
pExecutionArn_
  MapRunStatus
pStatus_
  UTCTime
pStartDate_
  Natural
pMaxConcurrency_
  Double
pToleratedFailurePercentage_
  Natural
pToleratedFailureCount_
  MapRunItemCounts
pItemCounts_
  MapRunExecutionCounts
pExecutionCounts_ =
    DescribeMapRunResponse'
      { $sel:stopDate:DescribeMapRunResponse' :: Maybe POSIX
stopDate = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeMapRunResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:mapRunArn:DescribeMapRunResponse' :: Text
mapRunArn = Text
pMapRunArn_,
        $sel:executionArn:DescribeMapRunResponse' :: Text
executionArn = Text
pExecutionArn_,
        $sel:status:DescribeMapRunResponse' :: MapRunStatus
status = MapRunStatus
pStatus_,
        $sel:startDate:DescribeMapRunResponse' :: POSIX
startDate = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartDate_,
        $sel:maxConcurrency:DescribeMapRunResponse' :: Natural
maxConcurrency = Natural
pMaxConcurrency_,
        $sel:toleratedFailurePercentage:DescribeMapRunResponse' :: Double
toleratedFailurePercentage =
          Double
pToleratedFailurePercentage_,
        $sel:toleratedFailureCount:DescribeMapRunResponse' :: Natural
toleratedFailureCount = Natural
pToleratedFailureCount_,
        $sel:itemCounts:DescribeMapRunResponse' :: MapRunItemCounts
itemCounts = MapRunItemCounts
pItemCounts_,
        $sel:executionCounts:DescribeMapRunResponse' :: MapRunExecutionCounts
executionCounts = MapRunExecutionCounts
pExecutionCounts_
      }

-- | The date when the Map Run was stopped.
describeMapRunResponse_stopDate :: Lens.Lens' DescribeMapRunResponse (Prelude.Maybe Prelude.UTCTime)
describeMapRunResponse_stopDate :: Lens' DescribeMapRunResponse (Maybe UTCTime)
describeMapRunResponse_stopDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMapRunResponse' {Maybe POSIX
stopDate :: Maybe POSIX
$sel:stopDate:DescribeMapRunResponse' :: DescribeMapRunResponse -> Maybe POSIX
stopDate} -> Maybe POSIX
stopDate) (\s :: DescribeMapRunResponse
s@DescribeMapRunResponse' {} Maybe POSIX
a -> DescribeMapRunResponse
s {$sel:stopDate:DescribeMapRunResponse' :: Maybe POSIX
stopDate = Maybe POSIX
a} :: DescribeMapRunResponse) 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 response's http status code.
describeMapRunResponse_httpStatus :: Lens.Lens' DescribeMapRunResponse Prelude.Int
describeMapRunResponse_httpStatus :: Lens' DescribeMapRunResponse Int
describeMapRunResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMapRunResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeMapRunResponse' :: DescribeMapRunResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeMapRunResponse
s@DescribeMapRunResponse' {} Int
a -> DescribeMapRunResponse
s {$sel:httpStatus:DescribeMapRunResponse' :: Int
httpStatus = Int
a} :: DescribeMapRunResponse)

-- | The Amazon Resource Name (ARN) that identifies a Map Run.
describeMapRunResponse_mapRunArn :: Lens.Lens' DescribeMapRunResponse Prelude.Text
describeMapRunResponse_mapRunArn :: Lens' DescribeMapRunResponse Text
describeMapRunResponse_mapRunArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMapRunResponse' {Text
mapRunArn :: Text
$sel:mapRunArn:DescribeMapRunResponse' :: DescribeMapRunResponse -> Text
mapRunArn} -> Text
mapRunArn) (\s :: DescribeMapRunResponse
s@DescribeMapRunResponse' {} Text
a -> DescribeMapRunResponse
s {$sel:mapRunArn:DescribeMapRunResponse' :: Text
mapRunArn = Text
a} :: DescribeMapRunResponse)

-- | The Amazon Resource Name (ARN) that identifies the execution in which
-- the Map Run was started.
describeMapRunResponse_executionArn :: Lens.Lens' DescribeMapRunResponse Prelude.Text
describeMapRunResponse_executionArn :: Lens' DescribeMapRunResponse Text
describeMapRunResponse_executionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMapRunResponse' {Text
executionArn :: Text
$sel:executionArn:DescribeMapRunResponse' :: DescribeMapRunResponse -> Text
executionArn} -> Text
executionArn) (\s :: DescribeMapRunResponse
s@DescribeMapRunResponse' {} Text
a -> DescribeMapRunResponse
s {$sel:executionArn:DescribeMapRunResponse' :: Text
executionArn = Text
a} :: DescribeMapRunResponse)

-- | The current status of the Map Run.
describeMapRunResponse_status :: Lens.Lens' DescribeMapRunResponse MapRunStatus
describeMapRunResponse_status :: Lens' DescribeMapRunResponse MapRunStatus
describeMapRunResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMapRunResponse' {MapRunStatus
status :: MapRunStatus
$sel:status:DescribeMapRunResponse' :: DescribeMapRunResponse -> MapRunStatus
status} -> MapRunStatus
status) (\s :: DescribeMapRunResponse
s@DescribeMapRunResponse' {} MapRunStatus
a -> DescribeMapRunResponse
s {$sel:status:DescribeMapRunResponse' :: MapRunStatus
status = MapRunStatus
a} :: DescribeMapRunResponse)

-- | The date when the Map Run was started.
describeMapRunResponse_startDate :: Lens.Lens' DescribeMapRunResponse Prelude.UTCTime
describeMapRunResponse_startDate :: Lens' DescribeMapRunResponse UTCTime
describeMapRunResponse_startDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMapRunResponse' {POSIX
startDate :: POSIX
$sel:startDate:DescribeMapRunResponse' :: DescribeMapRunResponse -> POSIX
startDate} -> POSIX
startDate) (\s :: DescribeMapRunResponse
s@DescribeMapRunResponse' {} POSIX
a -> DescribeMapRunResponse
s {$sel:startDate:DescribeMapRunResponse' :: POSIX
startDate = POSIX
a} :: DescribeMapRunResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The maximum number of child workflow executions configured to run in
-- parallel for the Map Run at the same time.
describeMapRunResponse_maxConcurrency :: Lens.Lens' DescribeMapRunResponse Prelude.Natural
describeMapRunResponse_maxConcurrency :: Lens' DescribeMapRunResponse Natural
describeMapRunResponse_maxConcurrency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMapRunResponse' {Natural
maxConcurrency :: Natural
$sel:maxConcurrency:DescribeMapRunResponse' :: DescribeMapRunResponse -> Natural
maxConcurrency} -> Natural
maxConcurrency) (\s :: DescribeMapRunResponse
s@DescribeMapRunResponse' {} Natural
a -> DescribeMapRunResponse
s {$sel:maxConcurrency:DescribeMapRunResponse' :: Natural
maxConcurrency = Natural
a} :: DescribeMapRunResponse)

-- | The maximum percentage of failed child workflow executions before the
-- Map Run fails.
describeMapRunResponse_toleratedFailurePercentage :: Lens.Lens' DescribeMapRunResponse Prelude.Double
describeMapRunResponse_toleratedFailurePercentage :: Lens' DescribeMapRunResponse Double
describeMapRunResponse_toleratedFailurePercentage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMapRunResponse' {Double
toleratedFailurePercentage :: Double
$sel:toleratedFailurePercentage:DescribeMapRunResponse' :: DescribeMapRunResponse -> Double
toleratedFailurePercentage} -> Double
toleratedFailurePercentage) (\s :: DescribeMapRunResponse
s@DescribeMapRunResponse' {} Double
a -> DescribeMapRunResponse
s {$sel:toleratedFailurePercentage:DescribeMapRunResponse' :: Double
toleratedFailurePercentage = Double
a} :: DescribeMapRunResponse)

-- | The maximum number of failed child workflow executions before the Map
-- Run fails.
describeMapRunResponse_toleratedFailureCount :: Lens.Lens' DescribeMapRunResponse Prelude.Natural
describeMapRunResponse_toleratedFailureCount :: Lens' DescribeMapRunResponse Natural
describeMapRunResponse_toleratedFailureCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMapRunResponse' {Natural
toleratedFailureCount :: Natural
$sel:toleratedFailureCount:DescribeMapRunResponse' :: DescribeMapRunResponse -> Natural
toleratedFailureCount} -> Natural
toleratedFailureCount) (\s :: DescribeMapRunResponse
s@DescribeMapRunResponse' {} Natural
a -> DescribeMapRunResponse
s {$sel:toleratedFailureCount:DescribeMapRunResponse' :: Natural
toleratedFailureCount = Natural
a} :: DescribeMapRunResponse)

-- | A JSON object that contains information about the total number of items,
-- and the item count for each processing status, such as @pending@ and
-- @failed@.
describeMapRunResponse_itemCounts :: Lens.Lens' DescribeMapRunResponse MapRunItemCounts
describeMapRunResponse_itemCounts :: Lens' DescribeMapRunResponse MapRunItemCounts
describeMapRunResponse_itemCounts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMapRunResponse' {MapRunItemCounts
itemCounts :: MapRunItemCounts
$sel:itemCounts:DescribeMapRunResponse' :: DescribeMapRunResponse -> MapRunItemCounts
itemCounts} -> MapRunItemCounts
itemCounts) (\s :: DescribeMapRunResponse
s@DescribeMapRunResponse' {} MapRunItemCounts
a -> DescribeMapRunResponse
s {$sel:itemCounts:DescribeMapRunResponse' :: MapRunItemCounts
itemCounts = MapRunItemCounts
a} :: DescribeMapRunResponse)

-- | A JSON object that contains information about the total number of child
-- workflow executions for the Map Run, and the count of child workflow
-- executions for each status, such as @failed@ and @succeeded@.
describeMapRunResponse_executionCounts :: Lens.Lens' DescribeMapRunResponse MapRunExecutionCounts
describeMapRunResponse_executionCounts :: Lens' DescribeMapRunResponse MapRunExecutionCounts
describeMapRunResponse_executionCounts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMapRunResponse' {MapRunExecutionCounts
executionCounts :: MapRunExecutionCounts
$sel:executionCounts:DescribeMapRunResponse' :: DescribeMapRunResponse -> MapRunExecutionCounts
executionCounts} -> MapRunExecutionCounts
executionCounts) (\s :: DescribeMapRunResponse
s@DescribeMapRunResponse' {} MapRunExecutionCounts
a -> DescribeMapRunResponse
s {$sel:executionCounts:DescribeMapRunResponse' :: MapRunExecutionCounts
executionCounts = MapRunExecutionCounts
a} :: DescribeMapRunResponse)

instance Prelude.NFData DescribeMapRunResponse where
  rnf :: DescribeMapRunResponse -> ()
rnf DescribeMapRunResponse' {Double
Int
Natural
Maybe POSIX
Text
POSIX
MapRunExecutionCounts
MapRunItemCounts
MapRunStatus
executionCounts :: MapRunExecutionCounts
itemCounts :: MapRunItemCounts
toleratedFailureCount :: Natural
toleratedFailurePercentage :: Double
maxConcurrency :: Natural
startDate :: POSIX
status :: MapRunStatus
executionArn :: Text
mapRunArn :: Text
httpStatus :: Int
stopDate :: Maybe POSIX
$sel:executionCounts:DescribeMapRunResponse' :: DescribeMapRunResponse -> MapRunExecutionCounts
$sel:itemCounts:DescribeMapRunResponse' :: DescribeMapRunResponse -> MapRunItemCounts
$sel:toleratedFailureCount:DescribeMapRunResponse' :: DescribeMapRunResponse -> Natural
$sel:toleratedFailurePercentage:DescribeMapRunResponse' :: DescribeMapRunResponse -> Double
$sel:maxConcurrency:DescribeMapRunResponse' :: DescribeMapRunResponse -> Natural
$sel:startDate:DescribeMapRunResponse' :: DescribeMapRunResponse -> POSIX
$sel:status:DescribeMapRunResponse' :: DescribeMapRunResponse -> MapRunStatus
$sel:executionArn:DescribeMapRunResponse' :: DescribeMapRunResponse -> Text
$sel:mapRunArn:DescribeMapRunResponse' :: DescribeMapRunResponse -> Text
$sel:httpStatus:DescribeMapRunResponse' :: DescribeMapRunResponse -> Int
$sel:stopDate:DescribeMapRunResponse' :: DescribeMapRunResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
stopDate
      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 Text
mapRunArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
executionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MapRunStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
startDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
maxConcurrency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Double
toleratedFailurePercentage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
toleratedFailureCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MapRunItemCounts
itemCounts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MapRunExecutionCounts
executionCounts