{-# 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.CodePipeline.PollForJobs
-- 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 information about any jobs for AWS CodePipeline to act on.
-- @PollForJobs@ is valid only for action types with \"Custom\" in the
-- owner field. If the action type contains \"AWS\" or \"ThirdParty\" in
-- the owner field, the @PollForJobs@ action returns an error.
--
-- When this API is called, AWS CodePipeline returns temporary credentials
-- for the S3 bucket used to store artifacts for the pipeline, if the
-- action requires access to that S3 bucket for input or output artifacts.
-- This API also returns any secret values defined for the action.
module Amazonka.CodePipeline.PollForJobs
  ( -- * Creating a Request
    PollForJobs (..),
    newPollForJobs,

    -- * Request Lenses
    pollForJobs_maxBatchSize,
    pollForJobs_queryParam,
    pollForJobs_actionTypeId,

    -- * Destructuring the Response
    PollForJobsResponse (..),
    newPollForJobsResponse,

    -- * Response Lenses
    pollForJobsResponse_jobs,
    pollForJobsResponse_httpStatus,
  )
where

import Amazonka.CodePipeline.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

-- | Represents the input of a @PollForJobs@ action.
--
-- /See:/ 'newPollForJobs' smart constructor.
data PollForJobs = PollForJobs'
  { -- | The maximum number of jobs to return in a poll for jobs call.
    PollForJobs -> Maybe Natural
maxBatchSize :: Prelude.Maybe Prelude.Natural,
    -- | A map of property names and values. For an action type with no queryable
    -- properties, this value must be null or an empty map. For an action type
    -- with a queryable property, you must supply that property as a key in the
    -- map. Only jobs whose action configuration matches the mapped value are
    -- returned.
    PollForJobs -> Maybe (HashMap Text Text)
queryParam :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Represents information about an action type.
    PollForJobs -> ActionTypeId
actionTypeId :: ActionTypeId
  }
  deriving (PollForJobs -> PollForJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PollForJobs -> PollForJobs -> Bool
$c/= :: PollForJobs -> PollForJobs -> Bool
== :: PollForJobs -> PollForJobs -> Bool
$c== :: PollForJobs -> PollForJobs -> Bool
Prelude.Eq, ReadPrec [PollForJobs]
ReadPrec PollForJobs
Int -> ReadS PollForJobs
ReadS [PollForJobs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PollForJobs]
$creadListPrec :: ReadPrec [PollForJobs]
readPrec :: ReadPrec PollForJobs
$creadPrec :: ReadPrec PollForJobs
readList :: ReadS [PollForJobs]
$creadList :: ReadS [PollForJobs]
readsPrec :: Int -> ReadS PollForJobs
$creadsPrec :: Int -> ReadS PollForJobs
Prelude.Read, Int -> PollForJobs -> ShowS
[PollForJobs] -> ShowS
PollForJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PollForJobs] -> ShowS
$cshowList :: [PollForJobs] -> ShowS
show :: PollForJobs -> String
$cshow :: PollForJobs -> String
showsPrec :: Int -> PollForJobs -> ShowS
$cshowsPrec :: Int -> PollForJobs -> ShowS
Prelude.Show, forall x. Rep PollForJobs x -> PollForJobs
forall x. PollForJobs -> Rep PollForJobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PollForJobs x -> PollForJobs
$cfrom :: forall x. PollForJobs -> Rep PollForJobs x
Prelude.Generic)

-- |
-- Create a value of 'PollForJobs' 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:
--
-- 'maxBatchSize', 'pollForJobs_maxBatchSize' - The maximum number of jobs to return in a poll for jobs call.
--
-- 'queryParam', 'pollForJobs_queryParam' - A map of property names and values. For an action type with no queryable
-- properties, this value must be null or an empty map. For an action type
-- with a queryable property, you must supply that property as a key in the
-- map. Only jobs whose action configuration matches the mapped value are
-- returned.
--
-- 'actionTypeId', 'pollForJobs_actionTypeId' - Represents information about an action type.
newPollForJobs ::
  -- | 'actionTypeId'
  ActionTypeId ->
  PollForJobs
newPollForJobs :: ActionTypeId -> PollForJobs
newPollForJobs ActionTypeId
pActionTypeId_ =
  PollForJobs'
    { $sel:maxBatchSize:PollForJobs' :: Maybe Natural
maxBatchSize = forall a. Maybe a
Prelude.Nothing,
      $sel:queryParam:PollForJobs' :: Maybe (HashMap Text Text)
queryParam = forall a. Maybe a
Prelude.Nothing,
      $sel:actionTypeId:PollForJobs' :: ActionTypeId
actionTypeId = ActionTypeId
pActionTypeId_
    }

-- | The maximum number of jobs to return in a poll for jobs call.
pollForJobs_maxBatchSize :: Lens.Lens' PollForJobs (Prelude.Maybe Prelude.Natural)
pollForJobs_maxBatchSize :: Lens' PollForJobs (Maybe Natural)
pollForJobs_maxBatchSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForJobs' {Maybe Natural
maxBatchSize :: Maybe Natural
$sel:maxBatchSize:PollForJobs' :: PollForJobs -> Maybe Natural
maxBatchSize} -> Maybe Natural
maxBatchSize) (\s :: PollForJobs
s@PollForJobs' {} Maybe Natural
a -> PollForJobs
s {$sel:maxBatchSize:PollForJobs' :: Maybe Natural
maxBatchSize = Maybe Natural
a} :: PollForJobs)

-- | A map of property names and values. For an action type with no queryable
-- properties, this value must be null or an empty map. For an action type
-- with a queryable property, you must supply that property as a key in the
-- map. Only jobs whose action configuration matches the mapped value are
-- returned.
pollForJobs_queryParam :: Lens.Lens' PollForJobs (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
pollForJobs_queryParam :: Lens' PollForJobs (Maybe (HashMap Text Text))
pollForJobs_queryParam = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForJobs' {Maybe (HashMap Text Text)
queryParam :: Maybe (HashMap Text Text)
$sel:queryParam:PollForJobs' :: PollForJobs -> Maybe (HashMap Text Text)
queryParam} -> Maybe (HashMap Text Text)
queryParam) (\s :: PollForJobs
s@PollForJobs' {} Maybe (HashMap Text Text)
a -> PollForJobs
s {$sel:queryParam:PollForJobs' :: Maybe (HashMap Text Text)
queryParam = Maybe (HashMap Text Text)
a} :: PollForJobs) 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

-- | Represents information about an action type.
pollForJobs_actionTypeId :: Lens.Lens' PollForJobs ActionTypeId
pollForJobs_actionTypeId :: Lens' PollForJobs ActionTypeId
pollForJobs_actionTypeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForJobs' {ActionTypeId
actionTypeId :: ActionTypeId
$sel:actionTypeId:PollForJobs' :: PollForJobs -> ActionTypeId
actionTypeId} -> ActionTypeId
actionTypeId) (\s :: PollForJobs
s@PollForJobs' {} ActionTypeId
a -> PollForJobs
s {$sel:actionTypeId:PollForJobs' :: ActionTypeId
actionTypeId = ActionTypeId
a} :: PollForJobs)

instance Core.AWSRequest PollForJobs where
  type AWSResponse PollForJobs = PollForJobsResponse
  request :: (Service -> Service) -> PollForJobs -> Request PollForJobs
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 PollForJobs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PollForJobs)))
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] -> Int -> PollForJobsResponse
PollForJobsResponse'
            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 PollForJobs where
  hashWithSalt :: Int -> PollForJobs -> Int
hashWithSalt Int
_salt PollForJobs' {Maybe Natural
Maybe (HashMap Text Text)
ActionTypeId
actionTypeId :: ActionTypeId
queryParam :: Maybe (HashMap Text Text)
maxBatchSize :: Maybe Natural
$sel:actionTypeId:PollForJobs' :: PollForJobs -> ActionTypeId
$sel:queryParam:PollForJobs' :: PollForJobs -> Maybe (HashMap Text Text)
$sel:maxBatchSize:PollForJobs' :: PollForJobs -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxBatchSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
queryParam
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ActionTypeId
actionTypeId

instance Prelude.NFData PollForJobs where
  rnf :: PollForJobs -> ()
rnf PollForJobs' {Maybe Natural
Maybe (HashMap Text Text)
ActionTypeId
actionTypeId :: ActionTypeId
queryParam :: Maybe (HashMap Text Text)
maxBatchSize :: Maybe Natural
$sel:actionTypeId:PollForJobs' :: PollForJobs -> ActionTypeId
$sel:queryParam:PollForJobs' :: PollForJobs -> Maybe (HashMap Text Text)
$sel:maxBatchSize:PollForJobs' :: PollForJobs -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxBatchSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
queryParam
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ActionTypeId
actionTypeId

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

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

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

-- | Represents the output of a @PollForJobs@ action.
--
-- /See:/ 'newPollForJobsResponse' smart constructor.
data PollForJobsResponse = PollForJobsResponse'
  { -- | Information about the jobs to take action on.
    PollForJobsResponse -> Maybe [Job]
jobs :: Prelude.Maybe [Job],
    -- | The response's http status code.
    PollForJobsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PollForJobsResponse -> PollForJobsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PollForJobsResponse -> PollForJobsResponse -> Bool
$c/= :: PollForJobsResponse -> PollForJobsResponse -> Bool
== :: PollForJobsResponse -> PollForJobsResponse -> Bool
$c== :: PollForJobsResponse -> PollForJobsResponse -> Bool
Prelude.Eq, Int -> PollForJobsResponse -> ShowS
[PollForJobsResponse] -> ShowS
PollForJobsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PollForJobsResponse] -> ShowS
$cshowList :: [PollForJobsResponse] -> ShowS
show :: PollForJobsResponse -> String
$cshow :: PollForJobsResponse -> String
showsPrec :: Int -> PollForJobsResponse -> ShowS
$cshowsPrec :: Int -> PollForJobsResponse -> ShowS
Prelude.Show, forall x. Rep PollForJobsResponse x -> PollForJobsResponse
forall x. PollForJobsResponse -> Rep PollForJobsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PollForJobsResponse x -> PollForJobsResponse
$cfrom :: forall x. PollForJobsResponse -> Rep PollForJobsResponse x
Prelude.Generic)

-- |
-- Create a value of 'PollForJobsResponse' 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', 'pollForJobsResponse_jobs' - Information about the jobs to take action on.
--
-- 'httpStatus', 'pollForJobsResponse_httpStatus' - The response's http status code.
newPollForJobsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PollForJobsResponse
newPollForJobsResponse :: Int -> PollForJobsResponse
newPollForJobsResponse Int
pHttpStatus_ =
  PollForJobsResponse'
    { $sel:jobs:PollForJobsResponse' :: Maybe [Job]
jobs = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PollForJobsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the jobs to take action on.
pollForJobsResponse_jobs :: Lens.Lens' PollForJobsResponse (Prelude.Maybe [Job])
pollForJobsResponse_jobs :: Lens' PollForJobsResponse (Maybe [Job])
pollForJobsResponse_jobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForJobsResponse' {Maybe [Job]
jobs :: Maybe [Job]
$sel:jobs:PollForJobsResponse' :: PollForJobsResponse -> Maybe [Job]
jobs} -> Maybe [Job]
jobs) (\s :: PollForJobsResponse
s@PollForJobsResponse' {} Maybe [Job]
a -> PollForJobsResponse
s {$sel:jobs:PollForJobsResponse' :: Maybe [Job]
jobs = Maybe [Job]
a} :: PollForJobsResponse) 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.
pollForJobsResponse_httpStatus :: Lens.Lens' PollForJobsResponse Prelude.Int
pollForJobsResponse_httpStatus :: Lens' PollForJobsResponse Int
pollForJobsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForJobsResponse' {Int
httpStatus :: Int
$sel:httpStatus:PollForJobsResponse' :: PollForJobsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: PollForJobsResponse
s@PollForJobsResponse' {} Int
a -> PollForJobsResponse
s {$sel:httpStatus:PollForJobsResponse' :: Int
httpStatus = Int
a} :: PollForJobsResponse)

instance Prelude.NFData PollForJobsResponse where
  rnf :: PollForJobsResponse -> ()
rnf PollForJobsResponse' {Int
Maybe [Job]
httpStatus :: Int
jobs :: Maybe [Job]
$sel:httpStatus:PollForJobsResponse' :: PollForJobsResponse -> Int
$sel:jobs:PollForJobsResponse' :: PollForJobsResponse -> 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 Int
httpStatus