{-# 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.BatchGetJobs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of resource metadata for a given list of job names. After
-- calling the @ListJobs@ operation, you can call this operation to access
-- the data to which you have been granted permissions. This operation
-- supports all IAM permissions, including permission conditions that uses
-- tags.
module Amazonka.Glue.BatchGetJobs
  ( -- * Creating a Request
    BatchGetJobs (..),
    newBatchGetJobs,

    -- * Request Lenses
    batchGetJobs_jobNames,

    -- * Destructuring the Response
    BatchGetJobsResponse (..),
    newBatchGetJobsResponse,

    -- * Response Lenses
    batchGetJobsResponse_jobs,
    batchGetJobsResponse_jobsNotFound,
    batchGetJobsResponse_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:/ 'newBatchGetJobs' smart constructor.
data BatchGetJobs = BatchGetJobs'
  { -- | A list of job names, which might be the names returned from the
    -- @ListJobs@ operation.
    BatchGetJobs -> [Text]
jobNames :: [Prelude.Text]
  }
  deriving (BatchGetJobs -> BatchGetJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetJobs -> BatchGetJobs -> Bool
$c/= :: BatchGetJobs -> BatchGetJobs -> Bool
== :: BatchGetJobs -> BatchGetJobs -> Bool
$c== :: BatchGetJobs -> BatchGetJobs -> Bool
Prelude.Eq, ReadPrec [BatchGetJobs]
ReadPrec BatchGetJobs
Int -> ReadS BatchGetJobs
ReadS [BatchGetJobs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetJobs]
$creadListPrec :: ReadPrec [BatchGetJobs]
readPrec :: ReadPrec BatchGetJobs
$creadPrec :: ReadPrec BatchGetJobs
readList :: ReadS [BatchGetJobs]
$creadList :: ReadS [BatchGetJobs]
readsPrec :: Int -> ReadS BatchGetJobs
$creadsPrec :: Int -> ReadS BatchGetJobs
Prelude.Read, Int -> BatchGetJobs -> ShowS
[BatchGetJobs] -> ShowS
BatchGetJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetJobs] -> ShowS
$cshowList :: [BatchGetJobs] -> ShowS
show :: BatchGetJobs -> String
$cshow :: BatchGetJobs -> String
showsPrec :: Int -> BatchGetJobs -> ShowS
$cshowsPrec :: Int -> BatchGetJobs -> ShowS
Prelude.Show, forall x. Rep BatchGetJobs x -> BatchGetJobs
forall x. BatchGetJobs -> Rep BatchGetJobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetJobs x -> BatchGetJobs
$cfrom :: forall x. BatchGetJobs -> Rep BatchGetJobs x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetJobs' 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:
--
-- 'jobNames', 'batchGetJobs_jobNames' - A list of job names, which might be the names returned from the
-- @ListJobs@ operation.
newBatchGetJobs ::
  BatchGetJobs
newBatchGetJobs :: BatchGetJobs
newBatchGetJobs =
  BatchGetJobs' {$sel:jobNames:BatchGetJobs' :: [Text]
jobNames = forall a. Monoid a => a
Prelude.mempty}

-- | A list of job names, which might be the names returned from the
-- @ListJobs@ operation.
batchGetJobs_jobNames :: Lens.Lens' BatchGetJobs [Prelude.Text]
batchGetJobs_jobNames :: Lens' BatchGetJobs [Text]
batchGetJobs_jobNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetJobs' {[Text]
jobNames :: [Text]
$sel:jobNames:BatchGetJobs' :: BatchGetJobs -> [Text]
jobNames} -> [Text]
jobNames) (\s :: BatchGetJobs
s@BatchGetJobs' {} [Text]
a -> BatchGetJobs
s {$sel:jobNames:BatchGetJobs' :: [Text]
jobNames = [Text]
a} :: BatchGetJobs) 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 Core.AWSRequest BatchGetJobs where
  type AWSResponse BatchGetJobs = BatchGetJobsResponse
  request :: (Service -> Service) -> BatchGetJobs -> Request BatchGetJobs
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 BatchGetJobs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse BatchGetJobs)))
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 [Job] -> Maybe [Text] -> Int -> BatchGetJobsResponse
BatchGetJobsResponse'
            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
"Jobs" 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
"JobsNotFound" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable BatchGetJobs where
  hashWithSalt :: Int -> BatchGetJobs -> Int
hashWithSalt Int
_salt BatchGetJobs' {[Text]
jobNames :: [Text]
$sel:jobNames:BatchGetJobs' :: BatchGetJobs -> [Text]
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
jobNames

instance Prelude.NFData BatchGetJobs where
  rnf :: BatchGetJobs -> ()
rnf BatchGetJobs' {[Text]
jobNames :: [Text]
$sel:jobNames:BatchGetJobs' :: BatchGetJobs -> [Text]
..} = forall a. NFData a => a -> ()
Prelude.rnf [Text]
jobNames

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

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

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

-- | /See:/ 'newBatchGetJobsResponse' smart constructor.
data BatchGetJobsResponse = BatchGetJobsResponse'
  { -- | A list of job definitions.
    BatchGetJobsResponse -> Maybe [Job]
jobs :: Prelude.Maybe [Job],
    -- | A list of names of jobs not found.
    BatchGetJobsResponse -> Maybe [Text]
jobsNotFound :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    BatchGetJobsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetJobsResponse -> BatchGetJobsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetJobsResponse -> BatchGetJobsResponse -> Bool
$c/= :: BatchGetJobsResponse -> BatchGetJobsResponse -> Bool
== :: BatchGetJobsResponse -> BatchGetJobsResponse -> Bool
$c== :: BatchGetJobsResponse -> BatchGetJobsResponse -> Bool
Prelude.Eq, Int -> BatchGetJobsResponse -> ShowS
[BatchGetJobsResponse] -> ShowS
BatchGetJobsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetJobsResponse] -> ShowS
$cshowList :: [BatchGetJobsResponse] -> ShowS
show :: BatchGetJobsResponse -> String
$cshow :: BatchGetJobsResponse -> String
showsPrec :: Int -> BatchGetJobsResponse -> ShowS
$cshowsPrec :: Int -> BatchGetJobsResponse -> ShowS
Prelude.Show, forall x. Rep BatchGetJobsResponse x -> BatchGetJobsResponse
forall x. BatchGetJobsResponse -> Rep BatchGetJobsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetJobsResponse x -> BatchGetJobsResponse
$cfrom :: forall x. BatchGetJobsResponse -> Rep BatchGetJobsResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetJobsResponse' 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:
--
-- 'jobs', 'batchGetJobsResponse_jobs' - A list of job definitions.
--
-- 'jobsNotFound', 'batchGetJobsResponse_jobsNotFound' - A list of names of jobs not found.
--
-- 'httpStatus', 'batchGetJobsResponse_httpStatus' - The response's http status code.
newBatchGetJobsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetJobsResponse
newBatchGetJobsResponse :: Int -> BatchGetJobsResponse
newBatchGetJobsResponse Int
pHttpStatus_ =
  BatchGetJobsResponse'
    { $sel:jobs:BatchGetJobsResponse' :: Maybe [Job]
jobs = forall a. Maybe a
Prelude.Nothing,
      $sel:jobsNotFound:BatchGetJobsResponse' :: Maybe [Text]
jobsNotFound = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetJobsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of job definitions.
batchGetJobsResponse_jobs :: Lens.Lens' BatchGetJobsResponse (Prelude.Maybe [Job])
batchGetJobsResponse_jobs :: Lens' BatchGetJobsResponse (Maybe [Job])
batchGetJobsResponse_jobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetJobsResponse' {Maybe [Job]
jobs :: Maybe [Job]
$sel:jobs:BatchGetJobsResponse' :: BatchGetJobsResponse -> Maybe [Job]
jobs} -> Maybe [Job]
jobs) (\s :: BatchGetJobsResponse
s@BatchGetJobsResponse' {} Maybe [Job]
a -> BatchGetJobsResponse
s {$sel:jobs:BatchGetJobsResponse' :: Maybe [Job]
jobs = Maybe [Job]
a} :: BatchGetJobsResponse) 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 list of names of jobs not found.
batchGetJobsResponse_jobsNotFound :: Lens.Lens' BatchGetJobsResponse (Prelude.Maybe [Prelude.Text])
batchGetJobsResponse_jobsNotFound :: Lens' BatchGetJobsResponse (Maybe [Text])
batchGetJobsResponse_jobsNotFound = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetJobsResponse' {Maybe [Text]
jobsNotFound :: Maybe [Text]
$sel:jobsNotFound:BatchGetJobsResponse' :: BatchGetJobsResponse -> Maybe [Text]
jobsNotFound} -> Maybe [Text]
jobsNotFound) (\s :: BatchGetJobsResponse
s@BatchGetJobsResponse' {} Maybe [Text]
a -> BatchGetJobsResponse
s {$sel:jobsNotFound:BatchGetJobsResponse' :: Maybe [Text]
jobsNotFound = Maybe [Text]
a} :: BatchGetJobsResponse) 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 response's http status code.
batchGetJobsResponse_httpStatus :: Lens.Lens' BatchGetJobsResponse Prelude.Int
batchGetJobsResponse_httpStatus :: Lens' BatchGetJobsResponse Int
batchGetJobsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetJobsResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchGetJobsResponse' :: BatchGetJobsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchGetJobsResponse
s@BatchGetJobsResponse' {} Int
a -> BatchGetJobsResponse
s {$sel:httpStatus:BatchGetJobsResponse' :: Int
httpStatus = Int
a} :: BatchGetJobsResponse)

instance Prelude.NFData BatchGetJobsResponse where
  rnf :: BatchGetJobsResponse -> ()
rnf BatchGetJobsResponse' {Int
Maybe [Text]
Maybe [Job]
httpStatus :: Int
jobsNotFound :: Maybe [Text]
jobs :: Maybe [Job]
$sel:httpStatus:BatchGetJobsResponse' :: BatchGetJobsResponse -> Int
$sel:jobsNotFound:BatchGetJobsResponse' :: BatchGetJobsResponse -> Maybe [Text]
$sel:jobs:BatchGetJobsResponse' :: BatchGetJobsResponse -> Maybe [Job]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Job]
jobs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
jobsNotFound
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus