{-# 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.SWF.PollForActivityTask
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Used by workers to get an ActivityTask from the specified activity
-- @taskList@. This initiates a long poll, where the service holds the HTTP
-- connection open and responds as soon as a task becomes available. The
-- maximum time the service holds on to the request before responding is 60
-- seconds. If no task is available within 60 seconds, the poll returns an
-- empty result. An empty result, in this context, means that an
-- ActivityTask is returned, but that the value of taskToken is an empty
-- string. If a task is returned, the worker should use its type to
-- identify and process it correctly.
--
-- Workers should set their client side socket timeout to at least 70
-- seconds (10 seconds higher than the maximum time service may hold the
-- poll request).
--
-- __Access Control__
--
-- You can use IAM policies to control this action\'s access to Amazon SWF
-- resources as follows:
--
-- -   Use a @Resource@ element with the domain name to limit the action to
--     only specified domains.
--
-- -   Use an @Action@ element to allow or deny permission to call this
--     action.
--
-- -   Constrain the @taskList.name@ parameter by using a @Condition@
--     element with the @swf:taskList.name@ key to allow the action to
--     access only certain task lists.
--
-- If the caller doesn\'t have sufficient permissions to invoke the action,
-- or the parameter values fall outside the specified constraints, the
-- action fails. The associated event attribute\'s @cause@ parameter is set
-- to @OPERATION_NOT_PERMITTED@. For details and example IAM policies, see
-- <https://docs.aws.amazon.com/amazonswf/latest/developerguide/swf-dev-iam.html Using IAM to Manage Access to Amazon SWF Workflows>
-- in the /Amazon SWF Developer Guide/.
module Amazonka.SWF.PollForActivityTask
  ( -- * Creating a Request
    PollForActivityTask (..),
    newPollForActivityTask,

    -- * Request Lenses
    pollForActivityTask_identity,
    pollForActivityTask_domain,
    pollForActivityTask_taskList,

    -- * Destructuring the Response
    PollForActivityTaskResponse (..),
    newPollForActivityTaskResponse,

    -- * Response Lenses
    pollForActivityTaskResponse_activityId,
    pollForActivityTaskResponse_activityType,
    pollForActivityTaskResponse_input,
    pollForActivityTaskResponse_taskToken,
    pollForActivityTaskResponse_workflowExecution,
    pollForActivityTaskResponse_httpStatus,
    pollForActivityTaskResponse_startedEventId,
  )
where

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

-- | /See:/ 'newPollForActivityTask' smart constructor.
data PollForActivityTask = PollForActivityTask'
  { -- | Identity of the worker making the request, recorded in the
    -- @ActivityTaskStarted@ event in the workflow history. This enables
    -- diagnostic tracing when problems arise. The form of this identity is
    -- user defined.
    PollForActivityTask -> Maybe Text
identity :: Prelude.Maybe Prelude.Text,
    -- | The name of the domain that contains the task lists being polled.
    PollForActivityTask -> Text
domain :: Prelude.Text,
    -- | Specifies the task list to poll for activity tasks.
    --
    -- The specified string must not start or end with whitespace. It must not
    -- contain a @:@ (colon), @\/@ (slash), @|@ (vertical bar), or any control
    -- characters (@\\u0000-\\u001f@ | @\\u007f-\\u009f@). Also, it must not
    -- /be/ the literal string @arn@.
    PollForActivityTask -> TaskList
taskList :: TaskList
  }
  deriving (PollForActivityTask -> PollForActivityTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PollForActivityTask -> PollForActivityTask -> Bool
$c/= :: PollForActivityTask -> PollForActivityTask -> Bool
== :: PollForActivityTask -> PollForActivityTask -> Bool
$c== :: PollForActivityTask -> PollForActivityTask -> Bool
Prelude.Eq, ReadPrec [PollForActivityTask]
ReadPrec PollForActivityTask
Int -> ReadS PollForActivityTask
ReadS [PollForActivityTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PollForActivityTask]
$creadListPrec :: ReadPrec [PollForActivityTask]
readPrec :: ReadPrec PollForActivityTask
$creadPrec :: ReadPrec PollForActivityTask
readList :: ReadS [PollForActivityTask]
$creadList :: ReadS [PollForActivityTask]
readsPrec :: Int -> ReadS PollForActivityTask
$creadsPrec :: Int -> ReadS PollForActivityTask
Prelude.Read, Int -> PollForActivityTask -> ShowS
[PollForActivityTask] -> ShowS
PollForActivityTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PollForActivityTask] -> ShowS
$cshowList :: [PollForActivityTask] -> ShowS
show :: PollForActivityTask -> String
$cshow :: PollForActivityTask -> String
showsPrec :: Int -> PollForActivityTask -> ShowS
$cshowsPrec :: Int -> PollForActivityTask -> ShowS
Prelude.Show, forall x. Rep PollForActivityTask x -> PollForActivityTask
forall x. PollForActivityTask -> Rep PollForActivityTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PollForActivityTask x -> PollForActivityTask
$cfrom :: forall x. PollForActivityTask -> Rep PollForActivityTask x
Prelude.Generic)

-- |
-- Create a value of 'PollForActivityTask' 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:
--
-- 'identity', 'pollForActivityTask_identity' - Identity of the worker making the request, recorded in the
-- @ActivityTaskStarted@ event in the workflow history. This enables
-- diagnostic tracing when problems arise. The form of this identity is
-- user defined.
--
-- 'domain', 'pollForActivityTask_domain' - The name of the domain that contains the task lists being polled.
--
-- 'taskList', 'pollForActivityTask_taskList' - Specifies the task list to poll for activity tasks.
--
-- The specified string must not start or end with whitespace. It must not
-- contain a @:@ (colon), @\/@ (slash), @|@ (vertical bar), or any control
-- characters (@\\u0000-\\u001f@ | @\\u007f-\\u009f@). Also, it must not
-- /be/ the literal string @arn@.
newPollForActivityTask ::
  -- | 'domain'
  Prelude.Text ->
  -- | 'taskList'
  TaskList ->
  PollForActivityTask
newPollForActivityTask :: Text -> TaskList -> PollForActivityTask
newPollForActivityTask Text
pDomain_ TaskList
pTaskList_ =
  PollForActivityTask'
    { $sel:identity:PollForActivityTask' :: Maybe Text
identity = forall a. Maybe a
Prelude.Nothing,
      $sel:domain:PollForActivityTask' :: Text
domain = Text
pDomain_,
      $sel:taskList:PollForActivityTask' :: TaskList
taskList = TaskList
pTaskList_
    }

-- | Identity of the worker making the request, recorded in the
-- @ActivityTaskStarted@ event in the workflow history. This enables
-- diagnostic tracing when problems arise. The form of this identity is
-- user defined.
pollForActivityTask_identity :: Lens.Lens' PollForActivityTask (Prelude.Maybe Prelude.Text)
pollForActivityTask_identity :: Lens' PollForActivityTask (Maybe Text)
pollForActivityTask_identity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForActivityTask' {Maybe Text
identity :: Maybe Text
$sel:identity:PollForActivityTask' :: PollForActivityTask -> Maybe Text
identity} -> Maybe Text
identity) (\s :: PollForActivityTask
s@PollForActivityTask' {} Maybe Text
a -> PollForActivityTask
s {$sel:identity:PollForActivityTask' :: Maybe Text
identity = Maybe Text
a} :: PollForActivityTask)

-- | The name of the domain that contains the task lists being polled.
pollForActivityTask_domain :: Lens.Lens' PollForActivityTask Prelude.Text
pollForActivityTask_domain :: Lens' PollForActivityTask Text
pollForActivityTask_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForActivityTask' {Text
domain :: Text
$sel:domain:PollForActivityTask' :: PollForActivityTask -> Text
domain} -> Text
domain) (\s :: PollForActivityTask
s@PollForActivityTask' {} Text
a -> PollForActivityTask
s {$sel:domain:PollForActivityTask' :: Text
domain = Text
a} :: PollForActivityTask)

-- | Specifies the task list to poll for activity tasks.
--
-- The specified string must not start or end with whitespace. It must not
-- contain a @:@ (colon), @\/@ (slash), @|@ (vertical bar), or any control
-- characters (@\\u0000-\\u001f@ | @\\u007f-\\u009f@). Also, it must not
-- /be/ the literal string @arn@.
pollForActivityTask_taskList :: Lens.Lens' PollForActivityTask TaskList
pollForActivityTask_taskList :: Lens' PollForActivityTask TaskList
pollForActivityTask_taskList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForActivityTask' {TaskList
taskList :: TaskList
$sel:taskList:PollForActivityTask' :: PollForActivityTask -> TaskList
taskList} -> TaskList
taskList) (\s :: PollForActivityTask
s@PollForActivityTask' {} TaskList
a -> PollForActivityTask
s {$sel:taskList:PollForActivityTask' :: TaskList
taskList = TaskList
a} :: PollForActivityTask)

instance Core.AWSRequest PollForActivityTask where
  type
    AWSResponse PollForActivityTask =
      PollForActivityTaskResponse
  request :: (Service -> Service)
-> PollForActivityTask -> Request PollForActivityTask
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 PollForActivityTask
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PollForActivityTask)))
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 Text
-> Maybe ActivityType
-> Maybe Text
-> Maybe Text
-> Maybe WorkflowExecution
-> Int
-> Integer
-> PollForActivityTaskResponse
PollForActivityTaskResponse'
            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
"activityId")
            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
"activityType")
            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
"input")
            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
"taskToken")
            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
"workflowExecution")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"startedEventId")
      )

instance Prelude.Hashable PollForActivityTask where
  hashWithSalt :: Int -> PollForActivityTask -> Int
hashWithSalt Int
_salt PollForActivityTask' {Maybe Text
Text
TaskList
taskList :: TaskList
domain :: Text
identity :: Maybe Text
$sel:taskList:PollForActivityTask' :: PollForActivityTask -> TaskList
$sel:domain:PollForActivityTask' :: PollForActivityTask -> Text
$sel:identity:PollForActivityTask' :: PollForActivityTask -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
identity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TaskList
taskList

instance Prelude.NFData PollForActivityTask where
  rnf :: PollForActivityTask -> ()
rnf PollForActivityTask' {Maybe Text
Text
TaskList
taskList :: TaskList
domain :: Text
identity :: Maybe Text
$sel:taskList:PollForActivityTask' :: PollForActivityTask -> TaskList
$sel:domain:PollForActivityTask' :: PollForActivityTask -> Text
$sel:identity:PollForActivityTask' :: PollForActivityTask -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
identity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TaskList
taskList

instance Data.ToHeaders PollForActivityTask where
  toHeaders :: PollForActivityTask -> 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
"SimpleWorkflowService.PollForActivityTask" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

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

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

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

-- | Unit of work sent to an activity worker.
--
-- /See:/ 'newPollForActivityTaskResponse' smart constructor.
data PollForActivityTaskResponse = PollForActivityTaskResponse'
  { -- | The unique ID of the task.
    PollForActivityTaskResponse -> Maybe Text
activityId :: Prelude.Maybe Prelude.Text,
    -- | The type of this activity task.
    PollForActivityTaskResponse -> Maybe ActivityType
activityType :: Prelude.Maybe ActivityType,
    -- | The inputs provided when the activity task was scheduled. The form of
    -- the input is user defined and should be meaningful to the activity
    -- implementation.
    PollForActivityTaskResponse -> Maybe Text
input :: Prelude.Maybe Prelude.Text,
    -- | The opaque string used as a handle on the task. This token is used by
    -- workers to communicate progress and response information back to the
    -- system about the task.
    PollForActivityTaskResponse -> Maybe Text
taskToken :: Prelude.Maybe Prelude.Text,
    -- | The workflow execution that started this activity task.
    PollForActivityTaskResponse -> Maybe WorkflowExecution
workflowExecution :: Prelude.Maybe WorkflowExecution,
    -- | The response's http status code.
    PollForActivityTaskResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ID of the @ActivityTaskStarted@ event recorded in the history.
    PollForActivityTaskResponse -> Integer
startedEventId :: Prelude.Integer
  }
  deriving (PollForActivityTaskResponse -> PollForActivityTaskResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PollForActivityTaskResponse -> PollForActivityTaskResponse -> Bool
$c/= :: PollForActivityTaskResponse -> PollForActivityTaskResponse -> Bool
== :: PollForActivityTaskResponse -> PollForActivityTaskResponse -> Bool
$c== :: PollForActivityTaskResponse -> PollForActivityTaskResponse -> Bool
Prelude.Eq, ReadPrec [PollForActivityTaskResponse]
ReadPrec PollForActivityTaskResponse
Int -> ReadS PollForActivityTaskResponse
ReadS [PollForActivityTaskResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PollForActivityTaskResponse]
$creadListPrec :: ReadPrec [PollForActivityTaskResponse]
readPrec :: ReadPrec PollForActivityTaskResponse
$creadPrec :: ReadPrec PollForActivityTaskResponse
readList :: ReadS [PollForActivityTaskResponse]
$creadList :: ReadS [PollForActivityTaskResponse]
readsPrec :: Int -> ReadS PollForActivityTaskResponse
$creadsPrec :: Int -> ReadS PollForActivityTaskResponse
Prelude.Read, Int -> PollForActivityTaskResponse -> ShowS
[PollForActivityTaskResponse] -> ShowS
PollForActivityTaskResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PollForActivityTaskResponse] -> ShowS
$cshowList :: [PollForActivityTaskResponse] -> ShowS
show :: PollForActivityTaskResponse -> String
$cshow :: PollForActivityTaskResponse -> String
showsPrec :: Int -> PollForActivityTaskResponse -> ShowS
$cshowsPrec :: Int -> PollForActivityTaskResponse -> ShowS
Prelude.Show, forall x.
Rep PollForActivityTaskResponse x -> PollForActivityTaskResponse
forall x.
PollForActivityTaskResponse -> Rep PollForActivityTaskResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PollForActivityTaskResponse x -> PollForActivityTaskResponse
$cfrom :: forall x.
PollForActivityTaskResponse -> Rep PollForActivityTaskResponse x
Prelude.Generic)

-- |
-- Create a value of 'PollForActivityTaskResponse' 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:
--
-- 'activityId', 'pollForActivityTaskResponse_activityId' - The unique ID of the task.
--
-- 'activityType', 'pollForActivityTaskResponse_activityType' - The type of this activity task.
--
-- 'input', 'pollForActivityTaskResponse_input' - The inputs provided when the activity task was scheduled. The form of
-- the input is user defined and should be meaningful to the activity
-- implementation.
--
-- 'taskToken', 'pollForActivityTaskResponse_taskToken' - The opaque string used as a handle on the task. This token is used by
-- workers to communicate progress and response information back to the
-- system about the task.
--
-- 'workflowExecution', 'pollForActivityTaskResponse_workflowExecution' - The workflow execution that started this activity task.
--
-- 'httpStatus', 'pollForActivityTaskResponse_httpStatus' - The response's http status code.
--
-- 'startedEventId', 'pollForActivityTaskResponse_startedEventId' - The ID of the @ActivityTaskStarted@ event recorded in the history.
newPollForActivityTaskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'startedEventId'
  Prelude.Integer ->
  PollForActivityTaskResponse
newPollForActivityTaskResponse :: Int -> Integer -> PollForActivityTaskResponse
newPollForActivityTaskResponse
  Int
pHttpStatus_
  Integer
pStartedEventId_ =
    PollForActivityTaskResponse'
      { $sel:activityId:PollForActivityTaskResponse' :: Maybe Text
activityId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:activityType:PollForActivityTaskResponse' :: Maybe ActivityType
activityType = forall a. Maybe a
Prelude.Nothing,
        $sel:input:PollForActivityTaskResponse' :: Maybe Text
input = forall a. Maybe a
Prelude.Nothing,
        $sel:taskToken:PollForActivityTaskResponse' :: Maybe Text
taskToken = forall a. Maybe a
Prelude.Nothing,
        $sel:workflowExecution:PollForActivityTaskResponse' :: Maybe WorkflowExecution
workflowExecution = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:PollForActivityTaskResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:startedEventId:PollForActivityTaskResponse' :: Integer
startedEventId = Integer
pStartedEventId_
      }

-- | The unique ID of the task.
pollForActivityTaskResponse_activityId :: Lens.Lens' PollForActivityTaskResponse (Prelude.Maybe Prelude.Text)
pollForActivityTaskResponse_activityId :: Lens' PollForActivityTaskResponse (Maybe Text)
pollForActivityTaskResponse_activityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForActivityTaskResponse' {Maybe Text
activityId :: Maybe Text
$sel:activityId:PollForActivityTaskResponse' :: PollForActivityTaskResponse -> Maybe Text
activityId} -> Maybe Text
activityId) (\s :: PollForActivityTaskResponse
s@PollForActivityTaskResponse' {} Maybe Text
a -> PollForActivityTaskResponse
s {$sel:activityId:PollForActivityTaskResponse' :: Maybe Text
activityId = Maybe Text
a} :: PollForActivityTaskResponse)

-- | The type of this activity task.
pollForActivityTaskResponse_activityType :: Lens.Lens' PollForActivityTaskResponse (Prelude.Maybe ActivityType)
pollForActivityTaskResponse_activityType :: Lens' PollForActivityTaskResponse (Maybe ActivityType)
pollForActivityTaskResponse_activityType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForActivityTaskResponse' {Maybe ActivityType
activityType :: Maybe ActivityType
$sel:activityType:PollForActivityTaskResponse' :: PollForActivityTaskResponse -> Maybe ActivityType
activityType} -> Maybe ActivityType
activityType) (\s :: PollForActivityTaskResponse
s@PollForActivityTaskResponse' {} Maybe ActivityType
a -> PollForActivityTaskResponse
s {$sel:activityType:PollForActivityTaskResponse' :: Maybe ActivityType
activityType = Maybe ActivityType
a} :: PollForActivityTaskResponse)

-- | The inputs provided when the activity task was scheduled. The form of
-- the input is user defined and should be meaningful to the activity
-- implementation.
pollForActivityTaskResponse_input :: Lens.Lens' PollForActivityTaskResponse (Prelude.Maybe Prelude.Text)
pollForActivityTaskResponse_input :: Lens' PollForActivityTaskResponse (Maybe Text)
pollForActivityTaskResponse_input = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForActivityTaskResponse' {Maybe Text
input :: Maybe Text
$sel:input:PollForActivityTaskResponse' :: PollForActivityTaskResponse -> Maybe Text
input} -> Maybe Text
input) (\s :: PollForActivityTaskResponse
s@PollForActivityTaskResponse' {} Maybe Text
a -> PollForActivityTaskResponse
s {$sel:input:PollForActivityTaskResponse' :: Maybe Text
input = Maybe Text
a} :: PollForActivityTaskResponse)

-- | The opaque string used as a handle on the task. This token is used by
-- workers to communicate progress and response information back to the
-- system about the task.
pollForActivityTaskResponse_taskToken :: Lens.Lens' PollForActivityTaskResponse (Prelude.Maybe Prelude.Text)
pollForActivityTaskResponse_taskToken :: Lens' PollForActivityTaskResponse (Maybe Text)
pollForActivityTaskResponse_taskToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForActivityTaskResponse' {Maybe Text
taskToken :: Maybe Text
$sel:taskToken:PollForActivityTaskResponse' :: PollForActivityTaskResponse -> Maybe Text
taskToken} -> Maybe Text
taskToken) (\s :: PollForActivityTaskResponse
s@PollForActivityTaskResponse' {} Maybe Text
a -> PollForActivityTaskResponse
s {$sel:taskToken:PollForActivityTaskResponse' :: Maybe Text
taskToken = Maybe Text
a} :: PollForActivityTaskResponse)

-- | The workflow execution that started this activity task.
pollForActivityTaskResponse_workflowExecution :: Lens.Lens' PollForActivityTaskResponse (Prelude.Maybe WorkflowExecution)
pollForActivityTaskResponse_workflowExecution :: Lens' PollForActivityTaskResponse (Maybe WorkflowExecution)
pollForActivityTaskResponse_workflowExecution = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForActivityTaskResponse' {Maybe WorkflowExecution
workflowExecution :: Maybe WorkflowExecution
$sel:workflowExecution:PollForActivityTaskResponse' :: PollForActivityTaskResponse -> Maybe WorkflowExecution
workflowExecution} -> Maybe WorkflowExecution
workflowExecution) (\s :: PollForActivityTaskResponse
s@PollForActivityTaskResponse' {} Maybe WorkflowExecution
a -> PollForActivityTaskResponse
s {$sel:workflowExecution:PollForActivityTaskResponse' :: Maybe WorkflowExecution
workflowExecution = Maybe WorkflowExecution
a} :: PollForActivityTaskResponse)

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

-- | The ID of the @ActivityTaskStarted@ event recorded in the history.
pollForActivityTaskResponse_startedEventId :: Lens.Lens' PollForActivityTaskResponse Prelude.Integer
pollForActivityTaskResponse_startedEventId :: Lens' PollForActivityTaskResponse Integer
pollForActivityTaskResponse_startedEventId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PollForActivityTaskResponse' {Integer
startedEventId :: Integer
$sel:startedEventId:PollForActivityTaskResponse' :: PollForActivityTaskResponse -> Integer
startedEventId} -> Integer
startedEventId) (\s :: PollForActivityTaskResponse
s@PollForActivityTaskResponse' {} Integer
a -> PollForActivityTaskResponse
s {$sel:startedEventId:PollForActivityTaskResponse' :: Integer
startedEventId = Integer
a} :: PollForActivityTaskResponse)

instance Prelude.NFData PollForActivityTaskResponse where
  rnf :: PollForActivityTaskResponse -> ()
rnf PollForActivityTaskResponse' {Int
Integer
Maybe Text
Maybe ActivityType
Maybe WorkflowExecution
startedEventId :: Integer
httpStatus :: Int
workflowExecution :: Maybe WorkflowExecution
taskToken :: Maybe Text
input :: Maybe Text
activityType :: Maybe ActivityType
activityId :: Maybe Text
$sel:startedEventId:PollForActivityTaskResponse' :: PollForActivityTaskResponse -> Integer
$sel:httpStatus:PollForActivityTaskResponse' :: PollForActivityTaskResponse -> Int
$sel:workflowExecution:PollForActivityTaskResponse' :: PollForActivityTaskResponse -> Maybe WorkflowExecution
$sel:taskToken:PollForActivityTaskResponse' :: PollForActivityTaskResponse -> Maybe Text
$sel:input:PollForActivityTaskResponse' :: PollForActivityTaskResponse -> Maybe Text
$sel:activityType:PollForActivityTaskResponse' :: PollForActivityTaskResponse -> Maybe ActivityType
$sel:activityId:PollForActivityTaskResponse' :: PollForActivityTaskResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
activityId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ActivityType
activityType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
input
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
taskToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowExecution
workflowExecution
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Integer
startedEventId