{-# 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.Glue.GetJobRuns
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves metadata for all runs of a given job definition.
--
-- This operation returns paginated results.
module Amazonka.Glue.GetJobRuns
  ( -- * Creating a Request
    GetJobRuns (..),
    newGetJobRuns,

    -- * Request Lenses
    getJobRuns_maxResults,
    getJobRuns_nextToken,
    getJobRuns_jobName,

    -- * Destructuring the Response
    GetJobRunsResponse (..),
    newGetJobRunsResponse,

    -- * Response Lenses
    getJobRunsResponse_jobRuns,
    getJobRunsResponse_nextToken,
    getJobRunsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetJobRuns' smart constructor.
data GetJobRuns = GetJobRuns'
  { -- | The maximum size of the response.
    GetJobRuns -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A continuation token, if this is a continuation call.
    GetJobRuns -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the job definition for which to retrieve all job runs.
    GetJobRuns -> Text
jobName :: Prelude.Text
  }
  deriving (GetJobRuns -> GetJobRuns -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetJobRuns -> GetJobRuns -> Bool
$c/= :: GetJobRuns -> GetJobRuns -> Bool
== :: GetJobRuns -> GetJobRuns -> Bool
$c== :: GetJobRuns -> GetJobRuns -> Bool
Prelude.Eq, ReadPrec [GetJobRuns]
ReadPrec GetJobRuns
Int -> ReadS GetJobRuns
ReadS [GetJobRuns]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetJobRuns]
$creadListPrec :: ReadPrec [GetJobRuns]
readPrec :: ReadPrec GetJobRuns
$creadPrec :: ReadPrec GetJobRuns
readList :: ReadS [GetJobRuns]
$creadList :: ReadS [GetJobRuns]
readsPrec :: Int -> ReadS GetJobRuns
$creadsPrec :: Int -> ReadS GetJobRuns
Prelude.Read, Int -> GetJobRuns -> ShowS
[GetJobRuns] -> ShowS
GetJobRuns -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetJobRuns] -> ShowS
$cshowList :: [GetJobRuns] -> ShowS
show :: GetJobRuns -> String
$cshow :: GetJobRuns -> String
showsPrec :: Int -> GetJobRuns -> ShowS
$cshowsPrec :: Int -> GetJobRuns -> ShowS
Prelude.Show, forall x. Rep GetJobRuns x -> GetJobRuns
forall x. GetJobRuns -> Rep GetJobRuns x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetJobRuns x -> GetJobRuns
$cfrom :: forall x. GetJobRuns -> Rep GetJobRuns x
Prelude.Generic)

-- |
-- Create a value of 'GetJobRuns' 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', 'getJobRuns_maxResults' - The maximum size of the response.
--
-- 'nextToken', 'getJobRuns_nextToken' - A continuation token, if this is a continuation call.
--
-- 'jobName', 'getJobRuns_jobName' - The name of the job definition for which to retrieve all job runs.
newGetJobRuns ::
  -- | 'jobName'
  Prelude.Text ->
  GetJobRuns
newGetJobRuns :: Text -> GetJobRuns
newGetJobRuns Text
pJobName_ =
  GetJobRuns'
    { $sel:maxResults:GetJobRuns' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetJobRuns' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:jobName:GetJobRuns' :: Text
jobName = Text
pJobName_
    }

-- | The maximum size of the response.
getJobRuns_maxResults :: Lens.Lens' GetJobRuns (Prelude.Maybe Prelude.Natural)
getJobRuns_maxResults :: Lens' GetJobRuns (Maybe Natural)
getJobRuns_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobRuns' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetJobRuns' :: GetJobRuns -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetJobRuns
s@GetJobRuns' {} Maybe Natural
a -> GetJobRuns
s {$sel:maxResults:GetJobRuns' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetJobRuns)

-- | A continuation token, if this is a continuation call.
getJobRuns_nextToken :: Lens.Lens' GetJobRuns (Prelude.Maybe Prelude.Text)
getJobRuns_nextToken :: Lens' GetJobRuns (Maybe Text)
getJobRuns_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobRuns' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetJobRuns' :: GetJobRuns -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetJobRuns
s@GetJobRuns' {} Maybe Text
a -> GetJobRuns
s {$sel:nextToken:GetJobRuns' :: Maybe Text
nextToken = Maybe Text
a} :: GetJobRuns)

-- | The name of the job definition for which to retrieve all job runs.
getJobRuns_jobName :: Lens.Lens' GetJobRuns Prelude.Text
getJobRuns_jobName :: Lens' GetJobRuns Text
getJobRuns_jobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobRuns' {Text
jobName :: Text
$sel:jobName:GetJobRuns' :: GetJobRuns -> Text
jobName} -> Text
jobName) (\s :: GetJobRuns
s@GetJobRuns' {} Text
a -> GetJobRuns
s {$sel:jobName:GetJobRuns' :: Text
jobName = Text
a} :: GetJobRuns)

instance Core.AWSPager GetJobRuns where
  page :: GetJobRuns -> AWSResponse GetJobRuns -> Maybe GetJobRuns
page GetJobRuns
rq AWSResponse GetJobRuns
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetJobRuns
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetJobRunsResponse (Maybe Text)
getJobRunsResponse_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 GetJobRuns
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetJobRunsResponse (Maybe [JobRun])
getJobRunsResponse_jobRuns
            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.$ GetJobRuns
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetJobRuns (Maybe Text)
getJobRuns_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetJobRuns
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetJobRunsResponse (Maybe Text)
getJobRunsResponse_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 GetJobRuns where
  type AWSResponse GetJobRuns = GetJobRunsResponse
  request :: (Service -> Service) -> GetJobRuns -> Request GetJobRuns
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 GetJobRuns
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetJobRuns)))
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 [JobRun] -> Maybe Text -> Int -> GetJobRunsResponse
GetJobRunsResponse'
            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
"JobRuns" 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 GetJobRuns where
  hashWithSalt :: Int -> GetJobRuns -> Int
hashWithSalt Int
_salt GetJobRuns' {Maybe Natural
Maybe Text
Text
jobName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:jobName:GetJobRuns' :: GetJobRuns -> Text
$sel:nextToken:GetJobRuns' :: GetJobRuns -> Maybe Text
$sel:maxResults:GetJobRuns' :: GetJobRuns -> 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
jobName

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

instance Data.ToHeaders GetJobRuns where
  toHeaders :: GetJobRuns -> 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
"AWSGlue.GetJobRuns" :: 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 GetJobRuns where
  toJSON :: GetJobRuns -> Value
toJSON GetJobRuns' {Maybe Natural
Maybe Text
Text
jobName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:jobName:GetJobRuns' :: GetJobRuns -> Text
$sel:nextToken:GetJobRuns' :: GetJobRuns -> Maybe Text
$sel:maxResults:GetJobRuns' :: GetJobRuns -> 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
"JobName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jobName)
          ]
      )

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

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

-- | /See:/ 'newGetJobRunsResponse' smart constructor.
data GetJobRunsResponse = GetJobRunsResponse'
  { -- | A list of job-run metadata objects.
    GetJobRunsResponse -> Maybe [JobRun]
jobRuns :: Prelude.Maybe [JobRun],
    -- | A continuation token, if not all requested job runs have been returned.
    GetJobRunsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetJobRunsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetJobRunsResponse -> GetJobRunsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetJobRunsResponse -> GetJobRunsResponse -> Bool
$c/= :: GetJobRunsResponse -> GetJobRunsResponse -> Bool
== :: GetJobRunsResponse -> GetJobRunsResponse -> Bool
$c== :: GetJobRunsResponse -> GetJobRunsResponse -> Bool
Prelude.Eq, ReadPrec [GetJobRunsResponse]
ReadPrec GetJobRunsResponse
Int -> ReadS GetJobRunsResponse
ReadS [GetJobRunsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetJobRunsResponse]
$creadListPrec :: ReadPrec [GetJobRunsResponse]
readPrec :: ReadPrec GetJobRunsResponse
$creadPrec :: ReadPrec GetJobRunsResponse
readList :: ReadS [GetJobRunsResponse]
$creadList :: ReadS [GetJobRunsResponse]
readsPrec :: Int -> ReadS GetJobRunsResponse
$creadsPrec :: Int -> ReadS GetJobRunsResponse
Prelude.Read, Int -> GetJobRunsResponse -> ShowS
[GetJobRunsResponse] -> ShowS
GetJobRunsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetJobRunsResponse] -> ShowS
$cshowList :: [GetJobRunsResponse] -> ShowS
show :: GetJobRunsResponse -> String
$cshow :: GetJobRunsResponse -> String
showsPrec :: Int -> GetJobRunsResponse -> ShowS
$cshowsPrec :: Int -> GetJobRunsResponse -> ShowS
Prelude.Show, forall x. Rep GetJobRunsResponse x -> GetJobRunsResponse
forall x. GetJobRunsResponse -> Rep GetJobRunsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetJobRunsResponse x -> GetJobRunsResponse
$cfrom :: forall x. GetJobRunsResponse -> Rep GetJobRunsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetJobRunsResponse' 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:
--
-- 'jobRuns', 'getJobRunsResponse_jobRuns' - A list of job-run metadata objects.
--
-- 'nextToken', 'getJobRunsResponse_nextToken' - A continuation token, if not all requested job runs have been returned.
--
-- 'httpStatus', 'getJobRunsResponse_httpStatus' - The response's http status code.
newGetJobRunsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetJobRunsResponse
newGetJobRunsResponse :: Int -> GetJobRunsResponse
newGetJobRunsResponse Int
pHttpStatus_ =
  GetJobRunsResponse'
    { $sel:jobRuns:GetJobRunsResponse' :: Maybe [JobRun]
jobRuns = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetJobRunsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetJobRunsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of job-run metadata objects.
getJobRunsResponse_jobRuns :: Lens.Lens' GetJobRunsResponse (Prelude.Maybe [JobRun])
getJobRunsResponse_jobRuns :: Lens' GetJobRunsResponse (Maybe [JobRun])
getJobRunsResponse_jobRuns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobRunsResponse' {Maybe [JobRun]
jobRuns :: Maybe [JobRun]
$sel:jobRuns:GetJobRunsResponse' :: GetJobRunsResponse -> Maybe [JobRun]
jobRuns} -> Maybe [JobRun]
jobRuns) (\s :: GetJobRunsResponse
s@GetJobRunsResponse' {} Maybe [JobRun]
a -> GetJobRunsResponse
s {$sel:jobRuns:GetJobRunsResponse' :: Maybe [JobRun]
jobRuns = Maybe [JobRun]
a} :: GetJobRunsResponse) 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

-- | A continuation token, if not all requested job runs have been returned.
getJobRunsResponse_nextToken :: Lens.Lens' GetJobRunsResponse (Prelude.Maybe Prelude.Text)
getJobRunsResponse_nextToken :: Lens' GetJobRunsResponse (Maybe Text)
getJobRunsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobRunsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetJobRunsResponse' :: GetJobRunsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetJobRunsResponse
s@GetJobRunsResponse' {} Maybe Text
a -> GetJobRunsResponse
s {$sel:nextToken:GetJobRunsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetJobRunsResponse)

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

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