{-# 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.Batch.DescribeJobs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes a list of Batch jobs.
module Amazonka.Batch.DescribeJobs
  ( -- * Creating a Request
    DescribeJobs (..),
    newDescribeJobs,

    -- * Request Lenses
    describeJobs_jobs,

    -- * Destructuring the Response
    DescribeJobsResponse (..),
    newDescribeJobsResponse,

    -- * Response Lenses
    describeJobsResponse_jobs,
    describeJobsResponse_httpStatus,
  )
where

import Amazonka.Batch.Types
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

-- | Contains the parameters for @DescribeJobs@.
--
-- /See:/ 'newDescribeJobs' smart constructor.
data DescribeJobs = DescribeJobs'
  { -- | A list of up to 100 job IDs.
    DescribeJobs -> [Text]
jobs :: [Prelude.Text]
  }
  deriving (DescribeJobs -> DescribeJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeJobs -> DescribeJobs -> Bool
$c/= :: DescribeJobs -> DescribeJobs -> Bool
== :: DescribeJobs -> DescribeJobs -> Bool
$c== :: DescribeJobs -> DescribeJobs -> Bool
Prelude.Eq, ReadPrec [DescribeJobs]
ReadPrec DescribeJobs
Int -> ReadS DescribeJobs
ReadS [DescribeJobs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeJobs]
$creadListPrec :: ReadPrec [DescribeJobs]
readPrec :: ReadPrec DescribeJobs
$creadPrec :: ReadPrec DescribeJobs
readList :: ReadS [DescribeJobs]
$creadList :: ReadS [DescribeJobs]
readsPrec :: Int -> ReadS DescribeJobs
$creadsPrec :: Int -> ReadS DescribeJobs
Prelude.Read, Int -> DescribeJobs -> ShowS
[DescribeJobs] -> ShowS
DescribeJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeJobs] -> ShowS
$cshowList :: [DescribeJobs] -> ShowS
show :: DescribeJobs -> String
$cshow :: DescribeJobs -> String
showsPrec :: Int -> DescribeJobs -> ShowS
$cshowsPrec :: Int -> DescribeJobs -> ShowS
Prelude.Show, forall x. Rep DescribeJobs x -> DescribeJobs
forall x. DescribeJobs -> Rep DescribeJobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeJobs x -> DescribeJobs
$cfrom :: forall x. DescribeJobs -> Rep DescribeJobs x
Prelude.Generic)

-- |
-- Create a value of 'DescribeJobs' 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', 'describeJobs_jobs' - A list of up to 100 job IDs.
newDescribeJobs ::
  DescribeJobs
newDescribeJobs :: DescribeJobs
newDescribeJobs =
  DescribeJobs' {$sel:jobs:DescribeJobs' :: [Text]
jobs = forall a. Monoid a => a
Prelude.mempty}

-- | A list of up to 100 job IDs.
describeJobs_jobs :: Lens.Lens' DescribeJobs [Prelude.Text]
describeJobs_jobs :: Lens' DescribeJobs [Text]
describeJobs_jobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeJobs' {[Text]
jobs :: [Text]
$sel:jobs:DescribeJobs' :: DescribeJobs -> [Text]
jobs} -> [Text]
jobs) (\s :: DescribeJobs
s@DescribeJobs' {} [Text]
a -> DescribeJobs
s {$sel:jobs:DescribeJobs' :: [Text]
jobs = [Text]
a} :: DescribeJobs) 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 DescribeJobs where
  type AWSResponse DescribeJobs = DescribeJobsResponse
  request :: (Service -> Service) -> DescribeJobs -> Request DescribeJobs
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 DescribeJobs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeJobs)))
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 [JobDetail] -> Int -> DescribeJobsResponse
DescribeJobsResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

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

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

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

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

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

-- | /See:/ 'newDescribeJobsResponse' smart constructor.
data DescribeJobsResponse = DescribeJobsResponse'
  { -- | The list of jobs.
    DescribeJobsResponse -> Maybe [JobDetail]
jobs :: Prelude.Maybe [JobDetail],
    -- | The response's http status code.
    DescribeJobsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeJobsResponse -> DescribeJobsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeJobsResponse -> DescribeJobsResponse -> Bool
$c/= :: DescribeJobsResponse -> DescribeJobsResponse -> Bool
== :: DescribeJobsResponse -> DescribeJobsResponse -> Bool
$c== :: DescribeJobsResponse -> DescribeJobsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeJobsResponse]
ReadPrec DescribeJobsResponse
Int -> ReadS DescribeJobsResponse
ReadS [DescribeJobsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeJobsResponse]
$creadListPrec :: ReadPrec [DescribeJobsResponse]
readPrec :: ReadPrec DescribeJobsResponse
$creadPrec :: ReadPrec DescribeJobsResponse
readList :: ReadS [DescribeJobsResponse]
$creadList :: ReadS [DescribeJobsResponse]
readsPrec :: Int -> ReadS DescribeJobsResponse
$creadsPrec :: Int -> ReadS DescribeJobsResponse
Prelude.Read, Int -> DescribeJobsResponse -> ShowS
[DescribeJobsResponse] -> ShowS
DescribeJobsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeJobsResponse] -> ShowS
$cshowList :: [DescribeJobsResponse] -> ShowS
show :: DescribeJobsResponse -> String
$cshow :: DescribeJobsResponse -> String
showsPrec :: Int -> DescribeJobsResponse -> ShowS
$cshowsPrec :: Int -> DescribeJobsResponse -> ShowS
Prelude.Show, forall x. Rep DescribeJobsResponse x -> DescribeJobsResponse
forall x. DescribeJobsResponse -> Rep DescribeJobsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeJobsResponse x -> DescribeJobsResponse
$cfrom :: forall x. DescribeJobsResponse -> Rep DescribeJobsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeJobsResponse' 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', 'describeJobsResponse_jobs' - The list of jobs.
--
-- 'httpStatus', 'describeJobsResponse_httpStatus' - The response's http status code.
newDescribeJobsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeJobsResponse
newDescribeJobsResponse :: Int -> DescribeJobsResponse
newDescribeJobsResponse Int
pHttpStatus_ =
  DescribeJobsResponse'
    { $sel:jobs:DescribeJobsResponse' :: Maybe [JobDetail]
jobs = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeJobsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of jobs.
describeJobsResponse_jobs :: Lens.Lens' DescribeJobsResponse (Prelude.Maybe [JobDetail])
describeJobsResponse_jobs :: Lens' DescribeJobsResponse (Maybe [JobDetail])
describeJobsResponse_jobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeJobsResponse' {Maybe [JobDetail]
jobs :: Maybe [JobDetail]
$sel:jobs:DescribeJobsResponse' :: DescribeJobsResponse -> Maybe [JobDetail]
jobs} -> Maybe [JobDetail]
jobs) (\s :: DescribeJobsResponse
s@DescribeJobsResponse' {} Maybe [JobDetail]
a -> DescribeJobsResponse
s {$sel:jobs:DescribeJobsResponse' :: Maybe [JobDetail]
jobs = Maybe [JobDetail]
a} :: DescribeJobsResponse) 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.
describeJobsResponse_httpStatus :: Lens.Lens' DescribeJobsResponse Prelude.Int
describeJobsResponse_httpStatus :: Lens' DescribeJobsResponse Int
describeJobsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeJobsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeJobsResponse' :: DescribeJobsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeJobsResponse
s@DescribeJobsResponse' {} Int
a -> DescribeJobsResponse
s {$sel:httpStatus:DescribeJobsResponse' :: Int
httpStatus = Int
a} :: DescribeJobsResponse)

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