{-# 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.TerminateWorkflowExecution
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Records a @WorkflowExecutionTerminated@ event and forces closure of the
-- workflow execution identified by the given domain, runId, and
-- workflowId. The child policy, registered with the workflow type or
-- specified when starting this execution, is applied to any open child
-- workflow executions of this workflow execution.
--
-- If the identified workflow execution was in progress, it is terminated
-- immediately.
--
-- If a runId isn\'t specified, then the @WorkflowExecutionTerminated@
-- event is recorded in the history of the current open workflow with the
-- matching workflowId in the domain.
--
-- You should consider using RequestCancelWorkflowExecution action instead
-- because it allows the workflow to gracefully close while
-- TerminateWorkflowExecution doesn\'t.
--
-- __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.
--
-- -   You cannot use an IAM policy to constrain this action\'s parameters.
--
-- 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.TerminateWorkflowExecution
  ( -- * Creating a Request
    TerminateWorkflowExecution (..),
    newTerminateWorkflowExecution,

    -- * Request Lenses
    terminateWorkflowExecution_childPolicy,
    terminateWorkflowExecution_details,
    terminateWorkflowExecution_reason,
    terminateWorkflowExecution_runId,
    terminateWorkflowExecution_domain,
    terminateWorkflowExecution_workflowId,

    -- * Destructuring the Response
    TerminateWorkflowExecutionResponse (..),
    newTerminateWorkflowExecutionResponse,
  )
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:/ 'newTerminateWorkflowExecution' smart constructor.
data TerminateWorkflowExecution = TerminateWorkflowExecution'
  { -- | If set, specifies the policy to use for the child workflow executions of
    -- the workflow execution being terminated. This policy overrides the child
    -- policy specified for the workflow execution at registration time or when
    -- starting the execution.
    --
    -- The supported child policies are:
    --
    -- -   @TERMINATE@ – The child executions are terminated.
    --
    -- -   @REQUEST_CANCEL@ – A request to cancel is attempted for each child
    --     execution by recording a @WorkflowExecutionCancelRequested@ event in
    --     its history. It is up to the decider to take appropriate actions
    --     when it receives an execution history with this event.
    --
    -- -   @ABANDON@ – No action is taken. The child executions continue to
    --     run.
    --
    -- A child policy for this workflow execution must be specified either as a
    -- default for the workflow type or through this parameter. If neither this
    -- parameter is set nor a default child policy was specified at
    -- registration time then a fault is returned.
    TerminateWorkflowExecution -> Maybe ChildPolicy
childPolicy :: Prelude.Maybe ChildPolicy,
    -- | Details for terminating the workflow execution.
    TerminateWorkflowExecution -> Maybe Text
details :: Prelude.Maybe Prelude.Text,
    -- | A descriptive reason for terminating the workflow execution.
    TerminateWorkflowExecution -> Maybe Text
reason :: Prelude.Maybe Prelude.Text,
    -- | The runId of the workflow execution to terminate.
    TerminateWorkflowExecution -> Maybe Text
runId :: Prelude.Maybe Prelude.Text,
    -- | The domain of the workflow execution to terminate.
    TerminateWorkflowExecution -> Text
domain :: Prelude.Text,
    -- | The workflowId of the workflow execution to terminate.
    TerminateWorkflowExecution -> Text
workflowId :: Prelude.Text
  }
  deriving (TerminateWorkflowExecution -> TerminateWorkflowExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TerminateWorkflowExecution -> TerminateWorkflowExecution -> Bool
$c/= :: TerminateWorkflowExecution -> TerminateWorkflowExecution -> Bool
== :: TerminateWorkflowExecution -> TerminateWorkflowExecution -> Bool
$c== :: TerminateWorkflowExecution -> TerminateWorkflowExecution -> Bool
Prelude.Eq, ReadPrec [TerminateWorkflowExecution]
ReadPrec TerminateWorkflowExecution
Int -> ReadS TerminateWorkflowExecution
ReadS [TerminateWorkflowExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TerminateWorkflowExecution]
$creadListPrec :: ReadPrec [TerminateWorkflowExecution]
readPrec :: ReadPrec TerminateWorkflowExecution
$creadPrec :: ReadPrec TerminateWorkflowExecution
readList :: ReadS [TerminateWorkflowExecution]
$creadList :: ReadS [TerminateWorkflowExecution]
readsPrec :: Int -> ReadS TerminateWorkflowExecution
$creadsPrec :: Int -> ReadS TerminateWorkflowExecution
Prelude.Read, Int -> TerminateWorkflowExecution -> ShowS
[TerminateWorkflowExecution] -> ShowS
TerminateWorkflowExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TerminateWorkflowExecution] -> ShowS
$cshowList :: [TerminateWorkflowExecution] -> ShowS
show :: TerminateWorkflowExecution -> String
$cshow :: TerminateWorkflowExecution -> String
showsPrec :: Int -> TerminateWorkflowExecution -> ShowS
$cshowsPrec :: Int -> TerminateWorkflowExecution -> ShowS
Prelude.Show, forall x.
Rep TerminateWorkflowExecution x -> TerminateWorkflowExecution
forall x.
TerminateWorkflowExecution -> Rep TerminateWorkflowExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TerminateWorkflowExecution x -> TerminateWorkflowExecution
$cfrom :: forall x.
TerminateWorkflowExecution -> Rep TerminateWorkflowExecution x
Prelude.Generic)

-- |
-- Create a value of 'TerminateWorkflowExecution' 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:
--
-- 'childPolicy', 'terminateWorkflowExecution_childPolicy' - If set, specifies the policy to use for the child workflow executions of
-- the workflow execution being terminated. This policy overrides the child
-- policy specified for the workflow execution at registration time or when
-- starting the execution.
--
-- The supported child policies are:
--
-- -   @TERMINATE@ – The child executions are terminated.
--
-- -   @REQUEST_CANCEL@ – A request to cancel is attempted for each child
--     execution by recording a @WorkflowExecutionCancelRequested@ event in
--     its history. It is up to the decider to take appropriate actions
--     when it receives an execution history with this event.
--
-- -   @ABANDON@ – No action is taken. The child executions continue to
--     run.
--
-- A child policy for this workflow execution must be specified either as a
-- default for the workflow type or through this parameter. If neither this
-- parameter is set nor a default child policy was specified at
-- registration time then a fault is returned.
--
-- 'details', 'terminateWorkflowExecution_details' - Details for terminating the workflow execution.
--
-- 'reason', 'terminateWorkflowExecution_reason' - A descriptive reason for terminating the workflow execution.
--
-- 'runId', 'terminateWorkflowExecution_runId' - The runId of the workflow execution to terminate.
--
-- 'domain', 'terminateWorkflowExecution_domain' - The domain of the workflow execution to terminate.
--
-- 'workflowId', 'terminateWorkflowExecution_workflowId' - The workflowId of the workflow execution to terminate.
newTerminateWorkflowExecution ::
  -- | 'domain'
  Prelude.Text ->
  -- | 'workflowId'
  Prelude.Text ->
  TerminateWorkflowExecution
newTerminateWorkflowExecution :: Text -> Text -> TerminateWorkflowExecution
newTerminateWorkflowExecution Text
pDomain_ Text
pWorkflowId_ =
  TerminateWorkflowExecution'
    { $sel:childPolicy:TerminateWorkflowExecution' :: Maybe ChildPolicy
childPolicy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:details:TerminateWorkflowExecution' :: Maybe Text
details = forall a. Maybe a
Prelude.Nothing,
      $sel:reason:TerminateWorkflowExecution' :: Maybe Text
reason = forall a. Maybe a
Prelude.Nothing,
      $sel:runId:TerminateWorkflowExecution' :: Maybe Text
runId = forall a. Maybe a
Prelude.Nothing,
      $sel:domain:TerminateWorkflowExecution' :: Text
domain = Text
pDomain_,
      $sel:workflowId:TerminateWorkflowExecution' :: Text
workflowId = Text
pWorkflowId_
    }

-- | If set, specifies the policy to use for the child workflow executions of
-- the workflow execution being terminated. This policy overrides the child
-- policy specified for the workflow execution at registration time or when
-- starting the execution.
--
-- The supported child policies are:
--
-- -   @TERMINATE@ – The child executions are terminated.
--
-- -   @REQUEST_CANCEL@ – A request to cancel is attempted for each child
--     execution by recording a @WorkflowExecutionCancelRequested@ event in
--     its history. It is up to the decider to take appropriate actions
--     when it receives an execution history with this event.
--
-- -   @ABANDON@ – No action is taken. The child executions continue to
--     run.
--
-- A child policy for this workflow execution must be specified either as a
-- default for the workflow type or through this parameter. If neither this
-- parameter is set nor a default child policy was specified at
-- registration time then a fault is returned.
terminateWorkflowExecution_childPolicy :: Lens.Lens' TerminateWorkflowExecution (Prelude.Maybe ChildPolicy)
terminateWorkflowExecution_childPolicy :: Lens' TerminateWorkflowExecution (Maybe ChildPolicy)
terminateWorkflowExecution_childPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TerminateWorkflowExecution' {Maybe ChildPolicy
childPolicy :: Maybe ChildPolicy
$sel:childPolicy:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe ChildPolicy
childPolicy} -> Maybe ChildPolicy
childPolicy) (\s :: TerminateWorkflowExecution
s@TerminateWorkflowExecution' {} Maybe ChildPolicy
a -> TerminateWorkflowExecution
s {$sel:childPolicy:TerminateWorkflowExecution' :: Maybe ChildPolicy
childPolicy = Maybe ChildPolicy
a} :: TerminateWorkflowExecution)

-- | Details for terminating the workflow execution.
terminateWorkflowExecution_details :: Lens.Lens' TerminateWorkflowExecution (Prelude.Maybe Prelude.Text)
terminateWorkflowExecution_details :: Lens' TerminateWorkflowExecution (Maybe Text)
terminateWorkflowExecution_details = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TerminateWorkflowExecution' {Maybe Text
details :: Maybe Text
$sel:details:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe Text
details} -> Maybe Text
details) (\s :: TerminateWorkflowExecution
s@TerminateWorkflowExecution' {} Maybe Text
a -> TerminateWorkflowExecution
s {$sel:details:TerminateWorkflowExecution' :: Maybe Text
details = Maybe Text
a} :: TerminateWorkflowExecution)

-- | A descriptive reason for terminating the workflow execution.
terminateWorkflowExecution_reason :: Lens.Lens' TerminateWorkflowExecution (Prelude.Maybe Prelude.Text)
terminateWorkflowExecution_reason :: Lens' TerminateWorkflowExecution (Maybe Text)
terminateWorkflowExecution_reason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TerminateWorkflowExecution' {Maybe Text
reason :: Maybe Text
$sel:reason:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe Text
reason} -> Maybe Text
reason) (\s :: TerminateWorkflowExecution
s@TerminateWorkflowExecution' {} Maybe Text
a -> TerminateWorkflowExecution
s {$sel:reason:TerminateWorkflowExecution' :: Maybe Text
reason = Maybe Text
a} :: TerminateWorkflowExecution)

-- | The runId of the workflow execution to terminate.
terminateWorkflowExecution_runId :: Lens.Lens' TerminateWorkflowExecution (Prelude.Maybe Prelude.Text)
terminateWorkflowExecution_runId :: Lens' TerminateWorkflowExecution (Maybe Text)
terminateWorkflowExecution_runId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TerminateWorkflowExecution' {Maybe Text
runId :: Maybe Text
$sel:runId:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe Text
runId} -> Maybe Text
runId) (\s :: TerminateWorkflowExecution
s@TerminateWorkflowExecution' {} Maybe Text
a -> TerminateWorkflowExecution
s {$sel:runId:TerminateWorkflowExecution' :: Maybe Text
runId = Maybe Text
a} :: TerminateWorkflowExecution)

-- | The domain of the workflow execution to terminate.
terminateWorkflowExecution_domain :: Lens.Lens' TerminateWorkflowExecution Prelude.Text
terminateWorkflowExecution_domain :: Lens' TerminateWorkflowExecution Text
terminateWorkflowExecution_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TerminateWorkflowExecution' {Text
domain :: Text
$sel:domain:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Text
domain} -> Text
domain) (\s :: TerminateWorkflowExecution
s@TerminateWorkflowExecution' {} Text
a -> TerminateWorkflowExecution
s {$sel:domain:TerminateWorkflowExecution' :: Text
domain = Text
a} :: TerminateWorkflowExecution)

-- | The workflowId of the workflow execution to terminate.
terminateWorkflowExecution_workflowId :: Lens.Lens' TerminateWorkflowExecution Prelude.Text
terminateWorkflowExecution_workflowId :: Lens' TerminateWorkflowExecution Text
terminateWorkflowExecution_workflowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TerminateWorkflowExecution' {Text
workflowId :: Text
$sel:workflowId:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Text
workflowId} -> Text
workflowId) (\s :: TerminateWorkflowExecution
s@TerminateWorkflowExecution' {} Text
a -> TerminateWorkflowExecution
s {$sel:workflowId:TerminateWorkflowExecution' :: Text
workflowId = Text
a} :: TerminateWorkflowExecution)

instance Core.AWSRequest TerminateWorkflowExecution where
  type
    AWSResponse TerminateWorkflowExecution =
      TerminateWorkflowExecutionResponse
  request :: (Service -> Service)
-> TerminateWorkflowExecution -> Request TerminateWorkflowExecution
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 TerminateWorkflowExecution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse TerminateWorkflowExecution)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      TerminateWorkflowExecutionResponse
TerminateWorkflowExecutionResponse'

instance Prelude.Hashable TerminateWorkflowExecution where
  hashWithSalt :: Int -> TerminateWorkflowExecution -> Int
hashWithSalt Int
_salt TerminateWorkflowExecution' {Maybe Text
Maybe ChildPolicy
Text
workflowId :: Text
domain :: Text
runId :: Maybe Text
reason :: Maybe Text
details :: Maybe Text
childPolicy :: Maybe ChildPolicy
$sel:workflowId:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Text
$sel:domain:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Text
$sel:runId:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe Text
$sel:reason:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe Text
$sel:details:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe Text
$sel:childPolicy:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe ChildPolicy
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChildPolicy
childPolicy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
details
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
runId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workflowId

instance Prelude.NFData TerminateWorkflowExecution where
  rnf :: TerminateWorkflowExecution -> ()
rnf TerminateWorkflowExecution' {Maybe Text
Maybe ChildPolicy
Text
workflowId :: Text
domain :: Text
runId :: Maybe Text
reason :: Maybe Text
details :: Maybe Text
childPolicy :: Maybe ChildPolicy
$sel:workflowId:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Text
$sel:domain:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Text
$sel:runId:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe Text
$sel:reason:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe Text
$sel:details:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe Text
$sel:childPolicy:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe ChildPolicy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ChildPolicy
childPolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
details
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
runId
      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 Text
workflowId

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

instance Data.ToJSON TerminateWorkflowExecution where
  toJSON :: TerminateWorkflowExecution -> Value
toJSON TerminateWorkflowExecution' {Maybe Text
Maybe ChildPolicy
Text
workflowId :: Text
domain :: Text
runId :: Maybe Text
reason :: Maybe Text
details :: Maybe Text
childPolicy :: Maybe ChildPolicy
$sel:workflowId:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Text
$sel:domain:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Text
$sel:runId:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe Text
$sel:reason:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe Text
$sel:details:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe Text
$sel:childPolicy:TerminateWorkflowExecution' :: TerminateWorkflowExecution -> Maybe ChildPolicy
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"childPolicy" 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 ChildPolicy
childPolicy,
            (Key
"details" 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
details,
            (Key
"reason" 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
reason,
            (Key
"runId" 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
runId,
            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
"workflowId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
workflowId)
          ]
      )

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

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

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

-- |
-- Create a value of 'TerminateWorkflowExecutionResponse' 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.
newTerminateWorkflowExecutionResponse ::
  TerminateWorkflowExecutionResponse
newTerminateWorkflowExecutionResponse :: TerminateWorkflowExecutionResponse
newTerminateWorkflowExecutionResponse =
  TerminateWorkflowExecutionResponse
TerminateWorkflowExecutionResponse'

instance
  Prelude.NFData
    TerminateWorkflowExecutionResponse
  where
  rnf :: TerminateWorkflowExecutionResponse -> ()
rnf TerminateWorkflowExecutionResponse
_ = ()