{-# 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.DataPipeline.PollForTask
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Task runners call @PollForTask@ to receive a task to perform from AWS
-- Data Pipeline. The task runner specifies which tasks it can perform by
-- setting a value for the @workerGroup@ parameter. The task returned can
-- come from any of the pipelines that match the @workerGroup@ value passed
-- in by the task runner and that was launched using the IAM user
-- credentials specified by the task runner.
--
-- If tasks are ready in the work queue, @PollForTask@ returns a response
-- immediately. If no tasks are available in the queue, @PollForTask@ uses
-- long-polling and holds on to a poll connection for up to a 90 seconds,
-- during which time the first newly scheduled task is handed to the task
-- runner. To accomodate this, set the socket timeout in your task runner
-- to 90 seconds. The task runner should not call @PollForTask@ again on
-- the same @workerGroup@ until it receives a response, and this can take
-- up to 90 seconds.
module Amazonka.DataPipeline.PollForTask
  ( -- * Creating a Request
    PollForTask (..),
    newPollForTask,

    -- * Request Lenses
    pollForTask_hostname,
    pollForTask_instanceIdentity,
    pollForTask_workerGroup,

    -- * Destructuring the Response
    PollForTaskResponse (..),
    newPollForTaskResponse,

    -- * Response Lenses
    pollForTaskResponse_taskObject,
    pollForTaskResponse_httpStatus,
  )
where

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

-- | Contains the parameters for PollForTask.
--
-- /See:/ 'newPollForTask' smart constructor.
data PollForTask = PollForTask'
  { -- | The public DNS name of the calling task runner.
    PollForTask -> Maybe Text
hostname :: Prelude.Maybe Prelude.Text,
    -- | Identity information for the EC2 instance that is hosting the task
    -- runner. You can get this value from the instance using
    -- @http:\/\/169.254.169.254\/latest\/meta-data\/instance-id@. For more
    -- information, see
    -- <http://docs.aws.amazon.com/AWSEC2/latest/UserGuide/AESDG-chapter-instancedata.html Instance Metadata>
    -- in the /Amazon Elastic Compute Cloud User Guide./ Passing in this value
    -- proves that your task runner is running on an EC2 instance, and ensures
    -- the proper AWS Data Pipeline service charges are applied to your
    -- pipeline.
    PollForTask -> Maybe InstanceIdentity
instanceIdentity :: Prelude.Maybe InstanceIdentity,
    -- | The type of task the task runner is configured to accept and process.
    -- The worker group is set as a field on objects in the pipeline when they
    -- are created. You can only specify a single value for @workerGroup@ in
    -- the call to @PollForTask@. There are no wildcard values permitted in
    -- @workerGroup@; the string must be an exact, case-sensitive, match.
    PollForTask -> Text
workerGroup :: Prelude.Text
  }
  deriving (PollForTask -> PollForTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PollForTask -> PollForTask -> Bool
$c/= :: PollForTask -> PollForTask -> Bool
== :: PollForTask -> PollForTask -> Bool
$c== :: PollForTask -> PollForTask -> Bool
Prelude.Eq, ReadPrec [PollForTask]
ReadPrec PollForTask
Int -> ReadS PollForTask
ReadS [PollForTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PollForTask]
$creadListPrec :: ReadPrec [PollForTask]
readPrec :: ReadPrec PollForTask
$creadPrec :: ReadPrec PollForTask
readList :: ReadS [PollForTask]
$creadList :: ReadS [PollForTask]
readsPrec :: Int -> ReadS PollForTask
$creadsPrec :: Int -> ReadS PollForTask
Prelude.Read, Int -> PollForTask -> ShowS
[PollForTask] -> ShowS
PollForTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PollForTask] -> ShowS
$cshowList :: [PollForTask] -> ShowS
show :: PollForTask -> String
$cshow :: PollForTask -> String
showsPrec :: Int -> PollForTask -> ShowS
$cshowsPrec :: Int -> PollForTask -> ShowS
Prelude.Show, forall x. Rep PollForTask x -> PollForTask
forall x. PollForTask -> Rep PollForTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PollForTask x -> PollForTask
$cfrom :: forall x. PollForTask -> Rep PollForTask x
Prelude.Generic)

-- |
-- Create a value of 'PollForTask' 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:
--
-- 'hostname', 'pollForTask_hostname' - The public DNS name of the calling task runner.
--
-- 'instanceIdentity', 'pollForTask_instanceIdentity' - Identity information for the EC2 instance that is hosting the task
-- runner. You can get this value from the instance using
-- @http:\/\/169.254.169.254\/latest\/meta-data\/instance-id@. For more
-- information, see
-- <http://docs.aws.amazon.com/AWSEC2/latest/UserGuide/AESDG-chapter-instancedata.html Instance Metadata>
-- in the /Amazon Elastic Compute Cloud User Guide./ Passing in this value
-- proves that your task runner is running on an EC2 instance, and ensures
-- the proper AWS Data Pipeline service charges are applied to your
-- pipeline.
--
-- 'workerGroup', 'pollForTask_workerGroup' - The type of task the task runner is configured to accept and process.
-- The worker group is set as a field on objects in the pipeline when they
-- are created. You can only specify a single value for @workerGroup@ in
-- the call to @PollForTask@. There are no wildcard values permitted in
-- @workerGroup@; the string must be an exact, case-sensitive, match.
newPollForTask ::
  -- | 'workerGroup'
  Prelude.Text ->
  PollForTask
newPollForTask :: Text -> PollForTask
newPollForTask Text
pWorkerGroup_ =
  PollForTask'
    { $sel:hostname:PollForTask' :: Maybe Text
hostname = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceIdentity:PollForTask' :: Maybe InstanceIdentity
instanceIdentity = forall a. Maybe a
Prelude.Nothing,
      $sel:workerGroup:PollForTask' :: Text
workerGroup = Text
pWorkerGroup_
    }

-- | The public DNS name of the calling task runner.
pollForTask_hostname :: Lens.Lens' PollForTask (Prelude.Maybe Prelude.Text)
pollForTask_hostname :: Lens' PollForTask (Maybe Text)
pollForTask_hostname = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForTask' {Maybe Text
hostname :: Maybe Text
$sel:hostname:PollForTask' :: PollForTask -> Maybe Text
hostname} -> Maybe Text
hostname) (\s :: PollForTask
s@PollForTask' {} Maybe Text
a -> PollForTask
s {$sel:hostname:PollForTask' :: Maybe Text
hostname = Maybe Text
a} :: PollForTask)

-- | Identity information for the EC2 instance that is hosting the task
-- runner. You can get this value from the instance using
-- @http:\/\/169.254.169.254\/latest\/meta-data\/instance-id@. For more
-- information, see
-- <http://docs.aws.amazon.com/AWSEC2/latest/UserGuide/AESDG-chapter-instancedata.html Instance Metadata>
-- in the /Amazon Elastic Compute Cloud User Guide./ Passing in this value
-- proves that your task runner is running on an EC2 instance, and ensures
-- the proper AWS Data Pipeline service charges are applied to your
-- pipeline.
pollForTask_instanceIdentity :: Lens.Lens' PollForTask (Prelude.Maybe InstanceIdentity)
pollForTask_instanceIdentity :: Lens' PollForTask (Maybe InstanceIdentity)
pollForTask_instanceIdentity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForTask' {Maybe InstanceIdentity
instanceIdentity :: Maybe InstanceIdentity
$sel:instanceIdentity:PollForTask' :: PollForTask -> Maybe InstanceIdentity
instanceIdentity} -> Maybe InstanceIdentity
instanceIdentity) (\s :: PollForTask
s@PollForTask' {} Maybe InstanceIdentity
a -> PollForTask
s {$sel:instanceIdentity:PollForTask' :: Maybe InstanceIdentity
instanceIdentity = Maybe InstanceIdentity
a} :: PollForTask)

-- | The type of task the task runner is configured to accept and process.
-- The worker group is set as a field on objects in the pipeline when they
-- are created. You can only specify a single value for @workerGroup@ in
-- the call to @PollForTask@. There are no wildcard values permitted in
-- @workerGroup@; the string must be an exact, case-sensitive, match.
pollForTask_workerGroup :: Lens.Lens' PollForTask Prelude.Text
pollForTask_workerGroup :: Lens' PollForTask Text
pollForTask_workerGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForTask' {Text
workerGroup :: Text
$sel:workerGroup:PollForTask' :: PollForTask -> Text
workerGroup} -> Text
workerGroup) (\s :: PollForTask
s@PollForTask' {} Text
a -> PollForTask
s {$sel:workerGroup:PollForTask' :: Text
workerGroup = Text
a} :: PollForTask)

instance Core.AWSRequest PollForTask where
  type AWSResponse PollForTask = PollForTaskResponse
  request :: (Service -> Service) -> PollForTask -> Request PollForTask
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 PollForTask
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PollForTask)))
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 TaskObject -> Int -> PollForTaskResponse
PollForTaskResponse'
            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
"taskObject")
            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 PollForTask where
  hashWithSalt :: Int -> PollForTask -> Int
hashWithSalt Int
_salt PollForTask' {Maybe Text
Maybe InstanceIdentity
Text
workerGroup :: Text
instanceIdentity :: Maybe InstanceIdentity
hostname :: Maybe Text
$sel:workerGroup:PollForTask' :: PollForTask -> Text
$sel:instanceIdentity:PollForTask' :: PollForTask -> Maybe InstanceIdentity
$sel:hostname:PollForTask' :: PollForTask -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostname
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceIdentity
instanceIdentity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workerGroup

instance Prelude.NFData PollForTask where
  rnf :: PollForTask -> ()
rnf PollForTask' {Maybe Text
Maybe InstanceIdentity
Text
workerGroup :: Text
instanceIdentity :: Maybe InstanceIdentity
hostname :: Maybe Text
$sel:workerGroup:PollForTask' :: PollForTask -> Text
$sel:instanceIdentity:PollForTask' :: PollForTask -> Maybe InstanceIdentity
$sel:hostname:PollForTask' :: PollForTask -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostname
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceIdentity
instanceIdentity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workerGroup

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

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

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

-- | Contains the output of PollForTask.
--
-- /See:/ 'newPollForTaskResponse' smart constructor.
data PollForTaskResponse = PollForTaskResponse'
  { -- | The information needed to complete the task that is being assigned to
    -- the task runner. One of the fields returned in this object is @taskId@,
    -- which contains an identifier for the task being assigned. The calling
    -- task runner uses @taskId@ in subsequent calls to ReportTaskProgress and
    -- SetTaskStatus.
    PollForTaskResponse -> Maybe TaskObject
taskObject :: Prelude.Maybe TaskObject,
    -- | The response's http status code.
    PollForTaskResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PollForTaskResponse -> PollForTaskResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PollForTaskResponse -> PollForTaskResponse -> Bool
$c/= :: PollForTaskResponse -> PollForTaskResponse -> Bool
== :: PollForTaskResponse -> PollForTaskResponse -> Bool
$c== :: PollForTaskResponse -> PollForTaskResponse -> Bool
Prelude.Eq, ReadPrec [PollForTaskResponse]
ReadPrec PollForTaskResponse
Int -> ReadS PollForTaskResponse
ReadS [PollForTaskResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PollForTaskResponse]
$creadListPrec :: ReadPrec [PollForTaskResponse]
readPrec :: ReadPrec PollForTaskResponse
$creadPrec :: ReadPrec PollForTaskResponse
readList :: ReadS [PollForTaskResponse]
$creadList :: ReadS [PollForTaskResponse]
readsPrec :: Int -> ReadS PollForTaskResponse
$creadsPrec :: Int -> ReadS PollForTaskResponse
Prelude.Read, Int -> PollForTaskResponse -> ShowS
[PollForTaskResponse] -> ShowS
PollForTaskResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PollForTaskResponse] -> ShowS
$cshowList :: [PollForTaskResponse] -> ShowS
show :: PollForTaskResponse -> String
$cshow :: PollForTaskResponse -> String
showsPrec :: Int -> PollForTaskResponse -> ShowS
$cshowsPrec :: Int -> PollForTaskResponse -> ShowS
Prelude.Show, forall x. Rep PollForTaskResponse x -> PollForTaskResponse
forall x. PollForTaskResponse -> Rep PollForTaskResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PollForTaskResponse x -> PollForTaskResponse
$cfrom :: forall x. PollForTaskResponse -> Rep PollForTaskResponse x
Prelude.Generic)

-- |
-- Create a value of 'PollForTaskResponse' 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:
--
-- 'taskObject', 'pollForTaskResponse_taskObject' - The information needed to complete the task that is being assigned to
-- the task runner. One of the fields returned in this object is @taskId@,
-- which contains an identifier for the task being assigned. The calling
-- task runner uses @taskId@ in subsequent calls to ReportTaskProgress and
-- SetTaskStatus.
--
-- 'httpStatus', 'pollForTaskResponse_httpStatus' - The response's http status code.
newPollForTaskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PollForTaskResponse
newPollForTaskResponse :: Int -> PollForTaskResponse
newPollForTaskResponse Int
pHttpStatus_ =
  PollForTaskResponse'
    { $sel:taskObject:PollForTaskResponse' :: Maybe TaskObject
taskObject = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PollForTaskResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The information needed to complete the task that is being assigned to
-- the task runner. One of the fields returned in this object is @taskId@,
-- which contains an identifier for the task being assigned. The calling
-- task runner uses @taskId@ in subsequent calls to ReportTaskProgress and
-- SetTaskStatus.
pollForTaskResponse_taskObject :: Lens.Lens' PollForTaskResponse (Prelude.Maybe TaskObject)
pollForTaskResponse_taskObject :: Lens' PollForTaskResponse (Maybe TaskObject)
pollForTaskResponse_taskObject = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForTaskResponse' {Maybe TaskObject
taskObject :: Maybe TaskObject
$sel:taskObject:PollForTaskResponse' :: PollForTaskResponse -> Maybe TaskObject
taskObject} -> Maybe TaskObject
taskObject) (\s :: PollForTaskResponse
s@PollForTaskResponse' {} Maybe TaskObject
a -> PollForTaskResponse
s {$sel:taskObject:PollForTaskResponse' :: Maybe TaskObject
taskObject = Maybe TaskObject
a} :: PollForTaskResponse)

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

instance Prelude.NFData PollForTaskResponse where
  rnf :: PollForTaskResponse -> ()
rnf PollForTaskResponse' {Int
Maybe TaskObject
httpStatus :: Int
taskObject :: Maybe TaskObject
$sel:httpStatus:PollForTaskResponse' :: PollForTaskResponse -> Int
$sel:taskObject:PollForTaskResponse' :: PollForTaskResponse -> Maybe TaskObject
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe TaskObject
taskObject
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus