{-# 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.M2.ListBatchJobExecutions
-- 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 historical, current, and scheduled batch job executions for a
-- specific application.
--
-- This operation returns paginated results.
module Amazonka.M2.ListBatchJobExecutions
  ( -- * Creating a Request
    ListBatchJobExecutions (..),
    newListBatchJobExecutions,

    -- * Request Lenses
    listBatchJobExecutions_executionIds,
    listBatchJobExecutions_jobName,
    listBatchJobExecutions_maxResults,
    listBatchJobExecutions_nextToken,
    listBatchJobExecutions_startedAfter,
    listBatchJobExecutions_startedBefore,
    listBatchJobExecutions_status,
    listBatchJobExecutions_applicationId,

    -- * Destructuring the Response
    ListBatchJobExecutionsResponse (..),
    newListBatchJobExecutionsResponse,

    -- * Response Lenses
    listBatchJobExecutionsResponse_nextToken,
    listBatchJobExecutionsResponse_httpStatus,
    listBatchJobExecutionsResponse_batchJobExecutions,
  )
where

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

-- | /See:/ 'newListBatchJobExecutions' smart constructor.
data ListBatchJobExecutions = ListBatchJobExecutions'
  { -- | The unique identifier of each batch job execution.
    ListBatchJobExecutions -> Maybe (NonEmpty Text)
executionIds :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The name of each batch job execution.
    ListBatchJobExecutions -> Maybe Text
jobName :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of batch job executions to return.
    ListBatchJobExecutions -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A pagination token to control the number of batch job executions
    -- displayed in the list.
    ListBatchJobExecutions -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The time after which the batch job executions started.
    ListBatchJobExecutions -> Maybe POSIX
startedAfter :: Prelude.Maybe Data.POSIX,
    -- | The time before the batch job executions started.
    ListBatchJobExecutions -> Maybe POSIX
startedBefore :: Prelude.Maybe Data.POSIX,
    -- | The status of the batch job executions.
    ListBatchJobExecutions -> Maybe BatchJobExecutionStatus
status :: Prelude.Maybe BatchJobExecutionStatus,
    -- | The unique identifier of the application.
    ListBatchJobExecutions -> Text
applicationId :: Prelude.Text
  }
  deriving (ListBatchJobExecutions -> ListBatchJobExecutions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBatchJobExecutions -> ListBatchJobExecutions -> Bool
$c/= :: ListBatchJobExecutions -> ListBatchJobExecutions -> Bool
== :: ListBatchJobExecutions -> ListBatchJobExecutions -> Bool
$c== :: ListBatchJobExecutions -> ListBatchJobExecutions -> Bool
Prelude.Eq, ReadPrec [ListBatchJobExecutions]
ReadPrec ListBatchJobExecutions
Int -> ReadS ListBatchJobExecutions
ReadS [ListBatchJobExecutions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBatchJobExecutions]
$creadListPrec :: ReadPrec [ListBatchJobExecutions]
readPrec :: ReadPrec ListBatchJobExecutions
$creadPrec :: ReadPrec ListBatchJobExecutions
readList :: ReadS [ListBatchJobExecutions]
$creadList :: ReadS [ListBatchJobExecutions]
readsPrec :: Int -> ReadS ListBatchJobExecutions
$creadsPrec :: Int -> ReadS ListBatchJobExecutions
Prelude.Read, Int -> ListBatchJobExecutions -> ShowS
[ListBatchJobExecutions] -> ShowS
ListBatchJobExecutions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBatchJobExecutions] -> ShowS
$cshowList :: [ListBatchJobExecutions] -> ShowS
show :: ListBatchJobExecutions -> String
$cshow :: ListBatchJobExecutions -> String
showsPrec :: Int -> ListBatchJobExecutions -> ShowS
$cshowsPrec :: Int -> ListBatchJobExecutions -> ShowS
Prelude.Show, forall x. Rep ListBatchJobExecutions x -> ListBatchJobExecutions
forall x. ListBatchJobExecutions -> Rep ListBatchJobExecutions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListBatchJobExecutions x -> ListBatchJobExecutions
$cfrom :: forall x. ListBatchJobExecutions -> Rep ListBatchJobExecutions x
Prelude.Generic)

-- |
-- Create a value of 'ListBatchJobExecutions' 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:
--
-- 'executionIds', 'listBatchJobExecutions_executionIds' - The unique identifier of each batch job execution.
--
-- 'jobName', 'listBatchJobExecutions_jobName' - The name of each batch job execution.
--
-- 'maxResults', 'listBatchJobExecutions_maxResults' - The maximum number of batch job executions to return.
--
-- 'nextToken', 'listBatchJobExecutions_nextToken' - A pagination token to control the number of batch job executions
-- displayed in the list.
--
-- 'startedAfter', 'listBatchJobExecutions_startedAfter' - The time after which the batch job executions started.
--
-- 'startedBefore', 'listBatchJobExecutions_startedBefore' - The time before the batch job executions started.
--
-- 'status', 'listBatchJobExecutions_status' - The status of the batch job executions.
--
-- 'applicationId', 'listBatchJobExecutions_applicationId' - The unique identifier of the application.
newListBatchJobExecutions ::
  -- | 'applicationId'
  Prelude.Text ->
  ListBatchJobExecutions
newListBatchJobExecutions :: Text -> ListBatchJobExecutions
newListBatchJobExecutions Text
pApplicationId_ =
  ListBatchJobExecutions'
    { $sel:executionIds:ListBatchJobExecutions' :: Maybe (NonEmpty Text)
executionIds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:jobName:ListBatchJobExecutions' :: Maybe Text
jobName = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListBatchJobExecutions' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListBatchJobExecutions' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:startedAfter:ListBatchJobExecutions' :: Maybe POSIX
startedAfter = forall a. Maybe a
Prelude.Nothing,
      $sel:startedBefore:ListBatchJobExecutions' :: Maybe POSIX
startedBefore = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ListBatchJobExecutions' :: Maybe BatchJobExecutionStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:applicationId:ListBatchJobExecutions' :: Text
applicationId = Text
pApplicationId_
    }

-- | The unique identifier of each batch job execution.
listBatchJobExecutions_executionIds :: Lens.Lens' ListBatchJobExecutions (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
listBatchJobExecutions_executionIds :: Lens' ListBatchJobExecutions (Maybe (NonEmpty Text))
listBatchJobExecutions_executionIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBatchJobExecutions' {Maybe (NonEmpty Text)
executionIds :: Maybe (NonEmpty Text)
$sel:executionIds:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe (NonEmpty Text)
executionIds} -> Maybe (NonEmpty Text)
executionIds) (\s :: ListBatchJobExecutions
s@ListBatchJobExecutions' {} Maybe (NonEmpty Text)
a -> ListBatchJobExecutions
s {$sel:executionIds:ListBatchJobExecutions' :: Maybe (NonEmpty Text)
executionIds = Maybe (NonEmpty Text)
a} :: ListBatchJobExecutions) 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 name of each batch job execution.
listBatchJobExecutions_jobName :: Lens.Lens' ListBatchJobExecutions (Prelude.Maybe Prelude.Text)
listBatchJobExecutions_jobName :: Lens' ListBatchJobExecutions (Maybe Text)
listBatchJobExecutions_jobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBatchJobExecutions' {Maybe Text
jobName :: Maybe Text
$sel:jobName:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Text
jobName} -> Maybe Text
jobName) (\s :: ListBatchJobExecutions
s@ListBatchJobExecutions' {} Maybe Text
a -> ListBatchJobExecutions
s {$sel:jobName:ListBatchJobExecutions' :: Maybe Text
jobName = Maybe Text
a} :: ListBatchJobExecutions)

-- | The maximum number of batch job executions to return.
listBatchJobExecutions_maxResults :: Lens.Lens' ListBatchJobExecutions (Prelude.Maybe Prelude.Natural)
listBatchJobExecutions_maxResults :: Lens' ListBatchJobExecutions (Maybe Natural)
listBatchJobExecutions_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBatchJobExecutions' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListBatchJobExecutions
s@ListBatchJobExecutions' {} Maybe Natural
a -> ListBatchJobExecutions
s {$sel:maxResults:ListBatchJobExecutions' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListBatchJobExecutions)

-- | A pagination token to control the number of batch job executions
-- displayed in the list.
listBatchJobExecutions_nextToken :: Lens.Lens' ListBatchJobExecutions (Prelude.Maybe Prelude.Text)
listBatchJobExecutions_nextToken :: Lens' ListBatchJobExecutions (Maybe Text)
listBatchJobExecutions_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBatchJobExecutions' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBatchJobExecutions
s@ListBatchJobExecutions' {} Maybe Text
a -> ListBatchJobExecutions
s {$sel:nextToken:ListBatchJobExecutions' :: Maybe Text
nextToken = Maybe Text
a} :: ListBatchJobExecutions)

-- | The time after which the batch job executions started.
listBatchJobExecutions_startedAfter :: Lens.Lens' ListBatchJobExecutions (Prelude.Maybe Prelude.UTCTime)
listBatchJobExecutions_startedAfter :: Lens' ListBatchJobExecutions (Maybe UTCTime)
listBatchJobExecutions_startedAfter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBatchJobExecutions' {Maybe POSIX
startedAfter :: Maybe POSIX
$sel:startedAfter:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe POSIX
startedAfter} -> Maybe POSIX
startedAfter) (\s :: ListBatchJobExecutions
s@ListBatchJobExecutions' {} Maybe POSIX
a -> ListBatchJobExecutions
s {$sel:startedAfter:ListBatchJobExecutions' :: Maybe POSIX
startedAfter = Maybe POSIX
a} :: ListBatchJobExecutions) 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 time before the batch job executions started.
listBatchJobExecutions_startedBefore :: Lens.Lens' ListBatchJobExecutions (Prelude.Maybe Prelude.UTCTime)
listBatchJobExecutions_startedBefore :: Lens' ListBatchJobExecutions (Maybe UTCTime)
listBatchJobExecutions_startedBefore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBatchJobExecutions' {Maybe POSIX
startedBefore :: Maybe POSIX
$sel:startedBefore:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe POSIX
startedBefore} -> Maybe POSIX
startedBefore) (\s :: ListBatchJobExecutions
s@ListBatchJobExecutions' {} Maybe POSIX
a -> ListBatchJobExecutions
s {$sel:startedBefore:ListBatchJobExecutions' :: Maybe POSIX
startedBefore = Maybe POSIX
a} :: ListBatchJobExecutions) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The status of the batch job executions.
listBatchJobExecutions_status :: Lens.Lens' ListBatchJobExecutions (Prelude.Maybe BatchJobExecutionStatus)
listBatchJobExecutions_status :: Lens' ListBatchJobExecutions (Maybe BatchJobExecutionStatus)
listBatchJobExecutions_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBatchJobExecutions' {Maybe BatchJobExecutionStatus
status :: Maybe BatchJobExecutionStatus
$sel:status:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe BatchJobExecutionStatus
status} -> Maybe BatchJobExecutionStatus
status) (\s :: ListBatchJobExecutions
s@ListBatchJobExecutions' {} Maybe BatchJobExecutionStatus
a -> ListBatchJobExecutions
s {$sel:status:ListBatchJobExecutions' :: Maybe BatchJobExecutionStatus
status = Maybe BatchJobExecutionStatus
a} :: ListBatchJobExecutions)

-- | The unique identifier of the application.
listBatchJobExecutions_applicationId :: Lens.Lens' ListBatchJobExecutions Prelude.Text
listBatchJobExecutions_applicationId :: Lens' ListBatchJobExecutions Text
listBatchJobExecutions_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBatchJobExecutions' {Text
applicationId :: Text
$sel:applicationId:ListBatchJobExecutions' :: ListBatchJobExecutions -> Text
applicationId} -> Text
applicationId) (\s :: ListBatchJobExecutions
s@ListBatchJobExecutions' {} Text
a -> ListBatchJobExecutions
s {$sel:applicationId:ListBatchJobExecutions' :: Text
applicationId = Text
a} :: ListBatchJobExecutions)

instance Core.AWSPager ListBatchJobExecutions where
  page :: ListBatchJobExecutions
-> AWSResponse ListBatchJobExecutions
-> Maybe ListBatchJobExecutions
page ListBatchJobExecutions
rq AWSResponse ListBatchJobExecutions
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListBatchJobExecutions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBatchJobExecutionsResponse (Maybe Text)
listBatchJobExecutionsResponse_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 ListBatchJobExecutions
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListBatchJobExecutionsResponse [BatchJobExecutionSummary]
listBatchJobExecutionsResponse_batchJobExecutions
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListBatchJobExecutions
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListBatchJobExecutions (Maybe Text)
listBatchJobExecutions_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListBatchJobExecutions
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListBatchJobExecutionsResponse (Maybe Text)
listBatchJobExecutionsResponse_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 ListBatchJobExecutions where
  type
    AWSResponse ListBatchJobExecutions =
      ListBatchJobExecutionsResponse
  request :: (Service -> Service)
-> ListBatchJobExecutions -> Request ListBatchJobExecutions
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListBatchJobExecutions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListBatchJobExecutions)))
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
-> [BatchJobExecutionSummary]
-> ListBatchJobExecutionsResponse
ListBatchJobExecutionsResponse'
            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
"batchJobExecutions"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable ListBatchJobExecutions where
  hashWithSalt :: Int -> ListBatchJobExecutions -> Int
hashWithSalt Int
_salt ListBatchJobExecutions' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe POSIX
Maybe BatchJobExecutionStatus
Text
applicationId :: Text
status :: Maybe BatchJobExecutionStatus
startedBefore :: Maybe POSIX
startedAfter :: Maybe POSIX
nextToken :: Maybe Text
maxResults :: Maybe Natural
jobName :: Maybe Text
executionIds :: Maybe (NonEmpty Text)
$sel:applicationId:ListBatchJobExecutions' :: ListBatchJobExecutions -> Text
$sel:status:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe BatchJobExecutionStatus
$sel:startedBefore:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe POSIX
$sel:startedAfter:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe POSIX
$sel:nextToken:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Text
$sel:maxResults:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Natural
$sel:jobName:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Text
$sel:executionIds:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe (NonEmpty Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
executionIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
jobName
      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 POSIX
startedAfter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
startedBefore
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BatchJobExecutionStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId

instance Prelude.NFData ListBatchJobExecutions where
  rnf :: ListBatchJobExecutions -> ()
rnf ListBatchJobExecutions' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe POSIX
Maybe BatchJobExecutionStatus
Text
applicationId :: Text
status :: Maybe BatchJobExecutionStatus
startedBefore :: Maybe POSIX
startedAfter :: Maybe POSIX
nextToken :: Maybe Text
maxResults :: Maybe Natural
jobName :: Maybe Text
executionIds :: Maybe (NonEmpty Text)
$sel:applicationId:ListBatchJobExecutions' :: ListBatchJobExecutions -> Text
$sel:status:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe BatchJobExecutionStatus
$sel:startedBefore:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe POSIX
$sel:startedAfter:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe POSIX
$sel:nextToken:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Text
$sel:maxResults:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Natural
$sel:jobName:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Text
$sel:executionIds:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
executionIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 POSIX
startedAfter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startedBefore
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BatchJobExecutionStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId

instance Data.ToHeaders ListBatchJobExecutions where
  toHeaders :: ListBatchJobExecutions -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath ListBatchJobExecutions where
  toPath :: ListBatchJobExecutions -> ByteString
toPath ListBatchJobExecutions' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe POSIX
Maybe BatchJobExecutionStatus
Text
applicationId :: Text
status :: Maybe BatchJobExecutionStatus
startedBefore :: Maybe POSIX
startedAfter :: Maybe POSIX
nextToken :: Maybe Text
maxResults :: Maybe Natural
jobName :: Maybe Text
executionIds :: Maybe (NonEmpty Text)
$sel:applicationId:ListBatchJobExecutions' :: ListBatchJobExecutions -> Text
$sel:status:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe BatchJobExecutionStatus
$sel:startedBefore:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe POSIX
$sel:startedAfter:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe POSIX
$sel:nextToken:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Text
$sel:maxResults:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Natural
$sel:jobName:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Text
$sel:executionIds:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe (NonEmpty Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/applications/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/batch-job-executions"
      ]

instance Data.ToQuery ListBatchJobExecutions where
  toQuery :: ListBatchJobExecutions -> QueryString
toQuery ListBatchJobExecutions' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe POSIX
Maybe BatchJobExecutionStatus
Text
applicationId :: Text
status :: Maybe BatchJobExecutionStatus
startedBefore :: Maybe POSIX
startedAfter :: Maybe POSIX
nextToken :: Maybe Text
maxResults :: Maybe Natural
jobName :: Maybe Text
executionIds :: Maybe (NonEmpty Text)
$sel:applicationId:ListBatchJobExecutions' :: ListBatchJobExecutions -> Text
$sel:status:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe BatchJobExecutionStatus
$sel:startedBefore:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe POSIX
$sel:startedAfter:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe POSIX
$sel:nextToken:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Text
$sel:maxResults:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Natural
$sel:jobName:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe Text
$sel:executionIds:ListBatchJobExecutions' :: ListBatchJobExecutions -> Maybe (NonEmpty Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"executionIds"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
executionIds),
        ByteString
"jobName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
jobName,
        ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"startedAfter" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe POSIX
startedAfter,
        ByteString
"startedBefore" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe POSIX
startedBefore,
        ByteString
"status" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe BatchJobExecutionStatus
status
      ]

-- | /See:/ 'newListBatchJobExecutionsResponse' smart constructor.
data ListBatchJobExecutionsResponse = ListBatchJobExecutionsResponse'
  { -- | A pagination token that\'s returned when the response doesn\'t contain
    -- all batch job executions.
    ListBatchJobExecutionsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListBatchJobExecutionsResponse -> Int
httpStatus :: Prelude.Int,
    -- | Returns a list of batch job executions for an application.
    ListBatchJobExecutionsResponse -> [BatchJobExecutionSummary]
batchJobExecutions :: [BatchJobExecutionSummary]
  }
  deriving (ListBatchJobExecutionsResponse
-> ListBatchJobExecutionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBatchJobExecutionsResponse
-> ListBatchJobExecutionsResponse -> Bool
$c/= :: ListBatchJobExecutionsResponse
-> ListBatchJobExecutionsResponse -> Bool
== :: ListBatchJobExecutionsResponse
-> ListBatchJobExecutionsResponse -> Bool
$c== :: ListBatchJobExecutionsResponse
-> ListBatchJobExecutionsResponse -> Bool
Prelude.Eq, ReadPrec [ListBatchJobExecutionsResponse]
ReadPrec ListBatchJobExecutionsResponse
Int -> ReadS ListBatchJobExecutionsResponse
ReadS [ListBatchJobExecutionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBatchJobExecutionsResponse]
$creadListPrec :: ReadPrec [ListBatchJobExecutionsResponse]
readPrec :: ReadPrec ListBatchJobExecutionsResponse
$creadPrec :: ReadPrec ListBatchJobExecutionsResponse
readList :: ReadS [ListBatchJobExecutionsResponse]
$creadList :: ReadS [ListBatchJobExecutionsResponse]
readsPrec :: Int -> ReadS ListBatchJobExecutionsResponse
$creadsPrec :: Int -> ReadS ListBatchJobExecutionsResponse
Prelude.Read, Int -> ListBatchJobExecutionsResponse -> ShowS
[ListBatchJobExecutionsResponse] -> ShowS
ListBatchJobExecutionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBatchJobExecutionsResponse] -> ShowS
$cshowList :: [ListBatchJobExecutionsResponse] -> ShowS
show :: ListBatchJobExecutionsResponse -> String
$cshow :: ListBatchJobExecutionsResponse -> String
showsPrec :: Int -> ListBatchJobExecutionsResponse -> ShowS
$cshowsPrec :: Int -> ListBatchJobExecutionsResponse -> ShowS
Prelude.Show, forall x.
Rep ListBatchJobExecutionsResponse x
-> ListBatchJobExecutionsResponse
forall x.
ListBatchJobExecutionsResponse
-> Rep ListBatchJobExecutionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListBatchJobExecutionsResponse x
-> ListBatchJobExecutionsResponse
$cfrom :: forall x.
ListBatchJobExecutionsResponse
-> Rep ListBatchJobExecutionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListBatchJobExecutionsResponse' 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', 'listBatchJobExecutionsResponse_nextToken' - A pagination token that\'s returned when the response doesn\'t contain
-- all batch job executions.
--
-- 'httpStatus', 'listBatchJobExecutionsResponse_httpStatus' - The response's http status code.
--
-- 'batchJobExecutions', 'listBatchJobExecutionsResponse_batchJobExecutions' - Returns a list of batch job executions for an application.
newListBatchJobExecutionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListBatchJobExecutionsResponse
newListBatchJobExecutionsResponse :: Int -> ListBatchJobExecutionsResponse
newListBatchJobExecutionsResponse Int
pHttpStatus_ =
  ListBatchJobExecutionsResponse'
    { $sel:nextToken:ListBatchJobExecutionsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListBatchJobExecutionsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:batchJobExecutions:ListBatchJobExecutionsResponse' :: [BatchJobExecutionSummary]
batchJobExecutions = forall a. Monoid a => a
Prelude.mempty
    }

-- | A pagination token that\'s returned when the response doesn\'t contain
-- all batch job executions.
listBatchJobExecutionsResponse_nextToken :: Lens.Lens' ListBatchJobExecutionsResponse (Prelude.Maybe Prelude.Text)
listBatchJobExecutionsResponse_nextToken :: Lens' ListBatchJobExecutionsResponse (Maybe Text)
listBatchJobExecutionsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBatchJobExecutionsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBatchJobExecutionsResponse' :: ListBatchJobExecutionsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBatchJobExecutionsResponse
s@ListBatchJobExecutionsResponse' {} Maybe Text
a -> ListBatchJobExecutionsResponse
s {$sel:nextToken:ListBatchJobExecutionsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListBatchJobExecutionsResponse)

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

-- | Returns a list of batch job executions for an application.
listBatchJobExecutionsResponse_batchJobExecutions :: Lens.Lens' ListBatchJobExecutionsResponse [BatchJobExecutionSummary]
listBatchJobExecutionsResponse_batchJobExecutions :: Lens' ListBatchJobExecutionsResponse [BatchJobExecutionSummary]
listBatchJobExecutionsResponse_batchJobExecutions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBatchJobExecutionsResponse' {[BatchJobExecutionSummary]
batchJobExecutions :: [BatchJobExecutionSummary]
$sel:batchJobExecutions:ListBatchJobExecutionsResponse' :: ListBatchJobExecutionsResponse -> [BatchJobExecutionSummary]
batchJobExecutions} -> [BatchJobExecutionSummary]
batchJobExecutions) (\s :: ListBatchJobExecutionsResponse
s@ListBatchJobExecutionsResponse' {} [BatchJobExecutionSummary]
a -> ListBatchJobExecutionsResponse
s {$sel:batchJobExecutions:ListBatchJobExecutionsResponse' :: [BatchJobExecutionSummary]
batchJobExecutions = [BatchJobExecutionSummary]
a} :: ListBatchJobExecutionsResponse) 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
    ListBatchJobExecutionsResponse
  where
  rnf :: ListBatchJobExecutionsResponse -> ()
rnf ListBatchJobExecutionsResponse' {Int
[BatchJobExecutionSummary]
Maybe Text
batchJobExecutions :: [BatchJobExecutionSummary]
httpStatus :: Int
nextToken :: Maybe Text
$sel:batchJobExecutions:ListBatchJobExecutionsResponse' :: ListBatchJobExecutionsResponse -> [BatchJobExecutionSummary]
$sel:httpStatus:ListBatchJobExecutionsResponse' :: ListBatchJobExecutionsResponse -> Int
$sel:nextToken:ListBatchJobExecutionsResponse' :: ListBatchJobExecutionsResponse -> 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 [BatchJobExecutionSummary]
batchJobExecutions