{-# 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 #-}
module Amazonka.StepFunctions.GetActivityTask
(
GetActivityTask (..),
newGetActivityTask,
getActivityTask_workerName,
getActivityTask_activityArn,
GetActivityTaskResponse (..),
newGetActivityTaskResponse,
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
data GetActivityTask = GetActivityTask'
{
GetActivityTask -> Maybe Text
workerName :: Prelude.Maybe Prelude.Text,
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)
newGetActivityTask ::
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_
}
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)
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
data GetActivityTaskResponse = GetActivityTaskResponse'
{
GetActivityTaskResponse -> Maybe (Sensitive Text)
input :: Prelude.Maybe (Data.Sensitive Prelude.Text),
GetActivityTaskResponse -> Maybe Text
taskToken :: Prelude.Maybe Prelude.Text,
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)
newGetActivityTaskResponse ::
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_
}
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
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)
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