{-# 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.Transfer.SendWorkflowStepState
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sends a callback for asynchronous custom steps.
--
-- The @ExecutionId@, @WorkflowId@, and @Token@ are passed to the target
-- resource during execution of a custom step of a workflow. You must
-- include those with their callback as well as providing a status.
module Amazonka.Transfer.SendWorkflowStepState
  ( -- * Creating a Request
    SendWorkflowStepState (..),
    newSendWorkflowStepState,

    -- * Request Lenses
    sendWorkflowStepState_workflowId,
    sendWorkflowStepState_executionId,
    sendWorkflowStepState_token,
    sendWorkflowStepState_status,

    -- * Destructuring the Response
    SendWorkflowStepStateResponse (..),
    newSendWorkflowStepStateResponse,

    -- * Response Lenses
    sendWorkflowStepStateResponse_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.Transfer.Types

-- | /See:/ 'newSendWorkflowStepState' smart constructor.
data SendWorkflowStepState = SendWorkflowStepState'
  { -- | A unique identifier for the workflow.
    SendWorkflowStepState -> Text
workflowId :: Prelude.Text,
    -- | A unique identifier for the execution of a workflow.
    SendWorkflowStepState -> Text
executionId :: Prelude.Text,
    -- | Used to distinguish between multiple callbacks for multiple Lambda steps
    -- within the same execution.
    SendWorkflowStepState -> Text
token :: Prelude.Text,
    -- | Indicates whether the specified step succeeded or failed.
    SendWorkflowStepState -> CustomStepStatus
status :: CustomStepStatus
  }
  deriving (SendWorkflowStepState -> SendWorkflowStepState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendWorkflowStepState -> SendWorkflowStepState -> Bool
$c/= :: SendWorkflowStepState -> SendWorkflowStepState -> Bool
== :: SendWorkflowStepState -> SendWorkflowStepState -> Bool
$c== :: SendWorkflowStepState -> SendWorkflowStepState -> Bool
Prelude.Eq, ReadPrec [SendWorkflowStepState]
ReadPrec SendWorkflowStepState
Int -> ReadS SendWorkflowStepState
ReadS [SendWorkflowStepState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendWorkflowStepState]
$creadListPrec :: ReadPrec [SendWorkflowStepState]
readPrec :: ReadPrec SendWorkflowStepState
$creadPrec :: ReadPrec SendWorkflowStepState
readList :: ReadS [SendWorkflowStepState]
$creadList :: ReadS [SendWorkflowStepState]
readsPrec :: Int -> ReadS SendWorkflowStepState
$creadsPrec :: Int -> ReadS SendWorkflowStepState
Prelude.Read, Int -> SendWorkflowStepState -> ShowS
[SendWorkflowStepState] -> ShowS
SendWorkflowStepState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendWorkflowStepState] -> ShowS
$cshowList :: [SendWorkflowStepState] -> ShowS
show :: SendWorkflowStepState -> String
$cshow :: SendWorkflowStepState -> String
showsPrec :: Int -> SendWorkflowStepState -> ShowS
$cshowsPrec :: Int -> SendWorkflowStepState -> ShowS
Prelude.Show, forall x. Rep SendWorkflowStepState x -> SendWorkflowStepState
forall x. SendWorkflowStepState -> Rep SendWorkflowStepState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendWorkflowStepState x -> SendWorkflowStepState
$cfrom :: forall x. SendWorkflowStepState -> Rep SendWorkflowStepState x
Prelude.Generic)

-- |
-- Create a value of 'SendWorkflowStepState' 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:
--
-- 'workflowId', 'sendWorkflowStepState_workflowId' - A unique identifier for the workflow.
--
-- 'executionId', 'sendWorkflowStepState_executionId' - A unique identifier for the execution of a workflow.
--
-- 'token', 'sendWorkflowStepState_token' - Used to distinguish between multiple callbacks for multiple Lambda steps
-- within the same execution.
--
-- 'status', 'sendWorkflowStepState_status' - Indicates whether the specified step succeeded or failed.
newSendWorkflowStepState ::
  -- | 'workflowId'
  Prelude.Text ->
  -- | 'executionId'
  Prelude.Text ->
  -- | 'token'
  Prelude.Text ->
  -- | 'status'
  CustomStepStatus ->
  SendWorkflowStepState
newSendWorkflowStepState :: Text -> Text -> Text -> CustomStepStatus -> SendWorkflowStepState
newSendWorkflowStepState
  Text
pWorkflowId_
  Text
pExecutionId_
  Text
pToken_
  CustomStepStatus
pStatus_ =
    SendWorkflowStepState'
      { $sel:workflowId:SendWorkflowStepState' :: Text
workflowId = Text
pWorkflowId_,
        $sel:executionId:SendWorkflowStepState' :: Text
executionId = Text
pExecutionId_,
        $sel:token:SendWorkflowStepState' :: Text
token = Text
pToken_,
        $sel:status:SendWorkflowStepState' :: CustomStepStatus
status = CustomStepStatus
pStatus_
      }

-- | A unique identifier for the workflow.
sendWorkflowStepState_workflowId :: Lens.Lens' SendWorkflowStepState Prelude.Text
sendWorkflowStepState_workflowId :: Lens' SendWorkflowStepState Text
sendWorkflowStepState_workflowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendWorkflowStepState' {Text
workflowId :: Text
$sel:workflowId:SendWorkflowStepState' :: SendWorkflowStepState -> Text
workflowId} -> Text
workflowId) (\s :: SendWorkflowStepState
s@SendWorkflowStepState' {} Text
a -> SendWorkflowStepState
s {$sel:workflowId:SendWorkflowStepState' :: Text
workflowId = Text
a} :: SendWorkflowStepState)

-- | A unique identifier for the execution of a workflow.
sendWorkflowStepState_executionId :: Lens.Lens' SendWorkflowStepState Prelude.Text
sendWorkflowStepState_executionId :: Lens' SendWorkflowStepState Text
sendWorkflowStepState_executionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendWorkflowStepState' {Text
executionId :: Text
$sel:executionId:SendWorkflowStepState' :: SendWorkflowStepState -> Text
executionId} -> Text
executionId) (\s :: SendWorkflowStepState
s@SendWorkflowStepState' {} Text
a -> SendWorkflowStepState
s {$sel:executionId:SendWorkflowStepState' :: Text
executionId = Text
a} :: SendWorkflowStepState)

-- | Used to distinguish between multiple callbacks for multiple Lambda steps
-- within the same execution.
sendWorkflowStepState_token :: Lens.Lens' SendWorkflowStepState Prelude.Text
sendWorkflowStepState_token :: Lens' SendWorkflowStepState Text
sendWorkflowStepState_token = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendWorkflowStepState' {Text
token :: Text
$sel:token:SendWorkflowStepState' :: SendWorkflowStepState -> Text
token} -> Text
token) (\s :: SendWorkflowStepState
s@SendWorkflowStepState' {} Text
a -> SendWorkflowStepState
s {$sel:token:SendWorkflowStepState' :: Text
token = Text
a} :: SendWorkflowStepState)

-- | Indicates whether the specified step succeeded or failed.
sendWorkflowStepState_status :: Lens.Lens' SendWorkflowStepState CustomStepStatus
sendWorkflowStepState_status :: Lens' SendWorkflowStepState CustomStepStatus
sendWorkflowStepState_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendWorkflowStepState' {CustomStepStatus
status :: CustomStepStatus
$sel:status:SendWorkflowStepState' :: SendWorkflowStepState -> CustomStepStatus
status} -> CustomStepStatus
status) (\s :: SendWorkflowStepState
s@SendWorkflowStepState' {} CustomStepStatus
a -> SendWorkflowStepState
s {$sel:status:SendWorkflowStepState' :: CustomStepStatus
status = CustomStepStatus
a} :: SendWorkflowStepState)

instance Core.AWSRequest SendWorkflowStepState where
  type
    AWSResponse SendWorkflowStepState =
      SendWorkflowStepStateResponse
  request :: (Service -> Service)
-> SendWorkflowStepState -> Request SendWorkflowStepState
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 SendWorkflowStepState
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SendWorkflowStepState)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> SendWorkflowStepStateResponse
SendWorkflowStepStateResponse'
            forall (f :: * -> *) a b. Functor 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 SendWorkflowStepState where
  hashWithSalt :: Int -> SendWorkflowStepState -> Int
hashWithSalt Int
_salt SendWorkflowStepState' {Text
CustomStepStatus
status :: CustomStepStatus
token :: Text
executionId :: Text
workflowId :: Text
$sel:status:SendWorkflowStepState' :: SendWorkflowStepState -> CustomStepStatus
$sel:token:SendWorkflowStepState' :: SendWorkflowStepState -> Text
$sel:executionId:SendWorkflowStepState' :: SendWorkflowStepState -> Text
$sel:workflowId:SendWorkflowStepState' :: SendWorkflowStepState -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workflowId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
executionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
token
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` CustomStepStatus
status

instance Prelude.NFData SendWorkflowStepState where
  rnf :: SendWorkflowStepState -> ()
rnf SendWorkflowStepState' {Text
CustomStepStatus
status :: CustomStepStatus
token :: Text
executionId :: Text
workflowId :: Text
$sel:status:SendWorkflowStepState' :: SendWorkflowStepState -> CustomStepStatus
$sel:token:SendWorkflowStepState' :: SendWorkflowStepState -> Text
$sel:executionId:SendWorkflowStepState' :: SendWorkflowStepState -> Text
$sel:workflowId:SendWorkflowStepState' :: SendWorkflowStepState -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
workflowId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
executionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
token
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf CustomStepStatus
status

instance Data.ToHeaders SendWorkflowStepState where
  toHeaders :: SendWorkflowStepState -> 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
"TransferService.SendWorkflowStepState" ::
                          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 SendWorkflowStepState where
  toJSON :: SendWorkflowStepState -> Value
toJSON SendWorkflowStepState' {Text
CustomStepStatus
status :: CustomStepStatus
token :: Text
executionId :: Text
workflowId :: Text
$sel:status:SendWorkflowStepState' :: SendWorkflowStepState -> CustomStepStatus
$sel:token:SendWorkflowStepState' :: SendWorkflowStepState -> Text
$sel:executionId:SendWorkflowStepState' :: SendWorkflowStepState -> Text
$sel:workflowId:SendWorkflowStepState' :: SendWorkflowStepState -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"WorkflowId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
workflowId),
            forall a. a -> Maybe a
Prelude.Just (Key
"ExecutionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
executionId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Token" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
token),
            forall a. a -> Maybe a
Prelude.Just (Key
"Status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= CustomStepStatus
status)
          ]
      )

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

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

-- | /See:/ 'newSendWorkflowStepStateResponse' smart constructor.
data SendWorkflowStepStateResponse = SendWorkflowStepStateResponse'
  { -- | The response's http status code.
    SendWorkflowStepStateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SendWorkflowStepStateResponse
-> SendWorkflowStepStateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendWorkflowStepStateResponse
-> SendWorkflowStepStateResponse -> Bool
$c/= :: SendWorkflowStepStateResponse
-> SendWorkflowStepStateResponse -> Bool
== :: SendWorkflowStepStateResponse
-> SendWorkflowStepStateResponse -> Bool
$c== :: SendWorkflowStepStateResponse
-> SendWorkflowStepStateResponse -> Bool
Prelude.Eq, ReadPrec [SendWorkflowStepStateResponse]
ReadPrec SendWorkflowStepStateResponse
Int -> ReadS SendWorkflowStepStateResponse
ReadS [SendWorkflowStepStateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendWorkflowStepStateResponse]
$creadListPrec :: ReadPrec [SendWorkflowStepStateResponse]
readPrec :: ReadPrec SendWorkflowStepStateResponse
$creadPrec :: ReadPrec SendWorkflowStepStateResponse
readList :: ReadS [SendWorkflowStepStateResponse]
$creadList :: ReadS [SendWorkflowStepStateResponse]
readsPrec :: Int -> ReadS SendWorkflowStepStateResponse
$creadsPrec :: Int -> ReadS SendWorkflowStepStateResponse
Prelude.Read, Int -> SendWorkflowStepStateResponse -> ShowS
[SendWorkflowStepStateResponse] -> ShowS
SendWorkflowStepStateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendWorkflowStepStateResponse] -> ShowS
$cshowList :: [SendWorkflowStepStateResponse] -> ShowS
show :: SendWorkflowStepStateResponse -> String
$cshow :: SendWorkflowStepStateResponse -> String
showsPrec :: Int -> SendWorkflowStepStateResponse -> ShowS
$cshowsPrec :: Int -> SendWorkflowStepStateResponse -> ShowS
Prelude.Show, forall x.
Rep SendWorkflowStepStateResponse x
-> SendWorkflowStepStateResponse
forall x.
SendWorkflowStepStateResponse
-> Rep SendWorkflowStepStateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SendWorkflowStepStateResponse x
-> SendWorkflowStepStateResponse
$cfrom :: forall x.
SendWorkflowStepStateResponse
-> Rep SendWorkflowStepStateResponse x
Prelude.Generic)

-- |
-- Create a value of 'SendWorkflowStepStateResponse' 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:
--
-- 'httpStatus', 'sendWorkflowStepStateResponse_httpStatus' - The response's http status code.
newSendWorkflowStepStateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SendWorkflowStepStateResponse
newSendWorkflowStepStateResponse :: Int -> SendWorkflowStepStateResponse
newSendWorkflowStepStateResponse Int
pHttpStatus_ =
  SendWorkflowStepStateResponse'
    { $sel:httpStatus:SendWorkflowStepStateResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData SendWorkflowStepStateResponse where
  rnf :: SendWorkflowStepStateResponse -> ()
rnf SendWorkflowStepStateResponse' {Int
httpStatus :: Int
$sel:httpStatus:SendWorkflowStepStateResponse' :: SendWorkflowStepStateResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus