{-# 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.StepFunctions.GetActivityTask
-- 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 retrieve a task (with the specified activity ARN)
-- which has been scheduled for execution by a running state machine. This
-- initiates a long poll, where the service holds the HTTP connection open
-- and responds as soon as a task becomes available (i.e. an execution of a
-- task of this type is needed.) 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 a @taskToken@ with a null string.
--
-- This API action isn\'t logged in CloudTrail.
--
-- Workers should set their client side socket timeout to at least 65
-- seconds (5 seconds higher than the maximum time the service may hold the
-- poll request).
--
-- Polling with @GetActivityTask@ can cause latency in some
-- implementations. See
-- <https://docs.aws.amazon.com/step-functions/latest/dg/bp-activity-pollers.html Avoid Latency When Polling for Activity Tasks>
-- in the Step Functions Developer Guide.
module Amazonka.StepFunctions.GetActivityTask
  ( -- * Creating a Request
    GetActivityTask (..),
    newGetActivityTask,

    -- * Request Lenses
    getActivityTask_workerName,
    getActivityTask_activityArn,

    -- * Destructuring the Response
    GetActivityTaskResponse (..),
    newGetActivityTaskResponse,

    -- * Response Lenses
    getActivityTaskResponse_input,
    getActivityTaskResponse_taskToken,
    getActivityTaskResponse_httpStatus,
  )
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.StepFunctions.Types

-- | /See:/ 'newGetActivityTask' smart constructor.
data GetActivityTask = GetActivityTask'
  { -- | You can provide an arbitrary name in order to identify the worker that
    -- the task is assigned to. This name is used when it is logged in the
    -- execution history.
    GetActivityTask -> Maybe Text
workerName :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the activity to retrieve tasks from
    -- (assigned when you create the task using CreateActivity.)
    GetActivityTask -> Text
activityArn :: Prelude.Text
  }
  deriving (GetActivityTask -> GetActivityTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetActivityTask -> GetActivityTask -> Bool
$c/= :: GetActivityTask -> GetActivityTask -> Bool
== :: GetActivityTask -> GetActivityTask -> Bool
$c== :: GetActivityTask -> GetActivityTask -> Bool
Prelude.Eq, ReadPrec [GetActivityTask]
ReadPrec GetActivityTask
Int -> ReadS GetActivityTask
ReadS [GetActivityTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetActivityTask]
$creadListPrec :: ReadPrec [GetActivityTask]
readPrec :: ReadPrec GetActivityTask
$creadPrec :: ReadPrec GetActivityTask
readList :: ReadS [GetActivityTask]
$creadList :: ReadS [GetActivityTask]
readsPrec :: Int -> ReadS GetActivityTask
$creadsPrec :: Int -> ReadS GetActivityTask
Prelude.Read, Int -> GetActivityTask -> ShowS
[GetActivityTask] -> ShowS
GetActivityTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetActivityTask] -> ShowS
$cshowList :: [GetActivityTask] -> ShowS
show :: GetActivityTask -> String
$cshow :: GetActivityTask -> String
showsPrec :: Int -> GetActivityTask -> ShowS
$cshowsPrec :: Int -> GetActivityTask -> ShowS
Prelude.Show, forall x. Rep GetActivityTask x -> GetActivityTask
forall x. GetActivityTask -> Rep GetActivityTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetActivityTask x -> GetActivityTask
$cfrom :: forall x. GetActivityTask -> Rep GetActivityTask x
Prelude.Generic)

-- |
-- Create a value of 'GetActivityTask' 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:
--
-- 'workerName', 'getActivityTask_workerName' - You can provide an arbitrary name in order to identify the worker that
-- the task is assigned to. This name is used when it is logged in the
-- execution history.
--
-- 'activityArn', 'getActivityTask_activityArn' - The Amazon Resource Name (ARN) of the activity to retrieve tasks from
-- (assigned when you create the task using CreateActivity.)
newGetActivityTask ::
  -- | 'activityArn'
  Prelude.Text ->
  GetActivityTask
newGetActivityTask :: Text -> GetActivityTask
newGetActivityTask Text
pActivityArn_ =
  GetActivityTask'
    { $sel:workerName:GetActivityTask' :: Maybe Text
workerName = forall a. Maybe a
Prelude.Nothing,
      $sel:activityArn:GetActivityTask' :: Text
activityArn = Text
pActivityArn_
    }

-- | You can provide an arbitrary name in order to identify the worker that
-- the task is assigned to. This name is used when it is logged in the
-- execution history.
getActivityTask_workerName :: Lens.Lens' GetActivityTask (Prelude.Maybe Prelude.Text)
getActivityTask_workerName :: Lens' GetActivityTask (Maybe Text)
getActivityTask_workerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetActivityTask' {Maybe Text
workerName :: Maybe Text
$sel:workerName:GetActivityTask' :: GetActivityTask -> Maybe Text
workerName} -> Maybe Text
workerName) (\s :: GetActivityTask
s@GetActivityTask' {} Maybe Text
a -> GetActivityTask
s {$sel:workerName:GetActivityTask' :: Maybe Text
workerName = Maybe Text
a} :: GetActivityTask)

-- | The Amazon Resource Name (ARN) of the activity to retrieve tasks from
-- (assigned when you create the task using CreateActivity.)
getActivityTask_activityArn :: Lens.Lens' GetActivityTask Prelude.Text
getActivityTask_activityArn :: Lens' GetActivityTask Text
getActivityTask_activityArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetActivityTask' {Text
activityArn :: Text
$sel:activityArn:GetActivityTask' :: GetActivityTask -> Text
activityArn} -> Text
activityArn) (\s :: GetActivityTask
s@GetActivityTask' {} Text
a -> GetActivityTask
s {$sel:activityArn:GetActivityTask' :: Text
activityArn = Text
a} :: GetActivityTask)

instance Core.AWSRequest GetActivityTask where
  type
    AWSResponse GetActivityTask =
      GetActivityTaskResponse
  request :: (Service -> Service) -> GetActivityTask -> Request GetActivityTask
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 GetActivityTask
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetActivityTask)))
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 (Sensitive Text)
-> Maybe Text -> Int -> GetActivityTaskResponse
GetActivityTaskResponse'
            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
"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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetActivityTask where
  hashWithSalt :: Int -> GetActivityTask -> Int
hashWithSalt Int
_salt GetActivityTask' {Maybe Text
Text
activityArn :: Text
workerName :: Maybe Text
$sel:activityArn:GetActivityTask' :: GetActivityTask -> Text
$sel:workerName:GetActivityTask' :: GetActivityTask -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
workerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
activityArn

instance Prelude.NFData GetActivityTask where
  rnf :: GetActivityTask -> ()
rnf GetActivityTask' {Maybe Text
Text
activityArn :: Text
workerName :: Maybe Text
$sel:activityArn:GetActivityTask' :: GetActivityTask -> Text
$sel:workerName:GetActivityTask' :: GetActivityTask -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
workerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
activityArn

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

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

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

-- | /See:/ 'newGetActivityTaskResponse' smart constructor.
data GetActivityTaskResponse = GetActivityTaskResponse'
  { -- | The string that contains the JSON input data for the task. Length
    -- constraints apply to the payload size, and are expressed as bytes in
    -- UTF-8 encoding.
    GetActivityTaskResponse -> Maybe (Sensitive Text)
input :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | A token that identifies the scheduled task. This token must be copied
    -- and included in subsequent calls to SendTaskHeartbeat, SendTaskSuccess
    -- or SendTaskFailure in order to report the progress or completion of the
    -- task.
    GetActivityTaskResponse -> Maybe Text
taskToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetActivityTaskResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetActivityTaskResponse -> GetActivityTaskResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetActivityTaskResponse -> GetActivityTaskResponse -> Bool
$c/= :: GetActivityTaskResponse -> GetActivityTaskResponse -> Bool
== :: GetActivityTaskResponse -> GetActivityTaskResponse -> Bool
$c== :: GetActivityTaskResponse -> GetActivityTaskResponse -> Bool
Prelude.Eq, Int -> GetActivityTaskResponse -> ShowS
[GetActivityTaskResponse] -> ShowS
GetActivityTaskResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetActivityTaskResponse] -> ShowS
$cshowList :: [GetActivityTaskResponse] -> ShowS
show :: GetActivityTaskResponse -> String
$cshow :: GetActivityTaskResponse -> String
showsPrec :: Int -> GetActivityTaskResponse -> ShowS
$cshowsPrec :: Int -> GetActivityTaskResponse -> ShowS
Prelude.Show, forall x. Rep GetActivityTaskResponse x -> GetActivityTaskResponse
forall x. GetActivityTaskResponse -> Rep GetActivityTaskResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetActivityTaskResponse x -> GetActivityTaskResponse
$cfrom :: forall x. GetActivityTaskResponse -> Rep GetActivityTaskResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetActivityTaskResponse' 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:
--
-- 'input', 'getActivityTaskResponse_input' - The string that contains the JSON input data for the task. Length
-- constraints apply to the payload size, and are expressed as bytes in
-- UTF-8 encoding.
--
-- 'taskToken', 'getActivityTaskResponse_taskToken' - A token that identifies the scheduled task. This token must be copied
-- and included in subsequent calls to SendTaskHeartbeat, SendTaskSuccess
-- or SendTaskFailure in order to report the progress or completion of the
-- task.
--
-- 'httpStatus', 'getActivityTaskResponse_httpStatus' - The response's http status code.
newGetActivityTaskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetActivityTaskResponse
newGetActivityTaskResponse :: Int -> GetActivityTaskResponse
newGetActivityTaskResponse Int
pHttpStatus_ =
  GetActivityTaskResponse'
    { $sel:input:GetActivityTaskResponse' :: Maybe (Sensitive Text)
input = forall a. Maybe a
Prelude.Nothing,
      $sel:taskToken:GetActivityTaskResponse' :: Maybe Text
taskToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetActivityTaskResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The string that contains the JSON input data for the task. Length
-- constraints apply to the payload size, and are expressed as bytes in
-- UTF-8 encoding.
getActivityTaskResponse_input :: Lens.Lens' GetActivityTaskResponse (Prelude.Maybe Prelude.Text)
getActivityTaskResponse_input :: Lens' GetActivityTaskResponse (Maybe Text)
getActivityTaskResponse_input = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetActivityTaskResponse' {Maybe (Sensitive Text)
input :: Maybe (Sensitive Text)
$sel:input:GetActivityTaskResponse' :: GetActivityTaskResponse -> Maybe (Sensitive Text)
input} -> Maybe (Sensitive Text)
input) (\s :: GetActivityTaskResponse
s@GetActivityTaskResponse' {} Maybe (Sensitive Text)
a -> GetActivityTaskResponse
s {$sel:input:GetActivityTaskResponse' :: Maybe (Sensitive Text)
input = Maybe (Sensitive Text)
a} :: GetActivityTaskResponse) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | A token that identifies the scheduled task. This token must be copied
-- and included in subsequent calls to SendTaskHeartbeat, SendTaskSuccess
-- or SendTaskFailure in order to report the progress or completion of the
-- task.
getActivityTaskResponse_taskToken :: Lens.Lens' GetActivityTaskResponse (Prelude.Maybe Prelude.Text)
getActivityTaskResponse_taskToken :: Lens' GetActivityTaskResponse (Maybe Text)
getActivityTaskResponse_taskToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetActivityTaskResponse' {Maybe Text
taskToken :: Maybe Text
$sel:taskToken:GetActivityTaskResponse' :: GetActivityTaskResponse -> Maybe Text
taskToken} -> Maybe Text
taskToken) (\s :: GetActivityTaskResponse
s@GetActivityTaskResponse' {} Maybe Text
a -> GetActivityTaskResponse
s {$sel:taskToken:GetActivityTaskResponse' :: Maybe Text
taskToken = Maybe Text
a} :: GetActivityTaskResponse)

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

instance Prelude.NFData GetActivityTaskResponse where
  rnf :: GetActivityTaskResponse -> ()
rnf GetActivityTaskResponse' {Int
Maybe Text
Maybe (Sensitive Text)
httpStatus :: Int
taskToken :: Maybe Text
input :: Maybe (Sensitive Text)
$sel:httpStatus:GetActivityTaskResponse' :: GetActivityTaskResponse -> Int
$sel:taskToken:GetActivityTaskResponse' :: GetActivityTaskResponse -> Maybe Text
$sel:input:GetActivityTaskResponse' :: GetActivityTaskResponse -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive 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 Int
httpStatus