{-# 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.SignalWorkflowExecution
-- 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 @WorkflowExecutionSignaled@ event in the workflow execution
-- history and creates a decision task for the workflow execution
-- identified by the given domain, workflowId and runId. The event is
-- recorded with the specified user defined signalName and input (if
-- provided).
--
-- If a runId isn\'t specified, then the @WorkflowExecutionSignaled@ event
-- is recorded in the history of the current open workflow with the
-- matching workflowId in the domain.
--
-- If the specified workflow execution isn\'t open, this method fails with
-- @UnknownResource@.
--
-- __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.SignalWorkflowExecution
  ( -- * Creating a Request
    SignalWorkflowExecution (..),
    newSignalWorkflowExecution,

    -- * Request Lenses
    signalWorkflowExecution_input,
    signalWorkflowExecution_runId,
    signalWorkflowExecution_domain,
    signalWorkflowExecution_workflowId,
    signalWorkflowExecution_signalName,

    -- * Destructuring the Response
    SignalWorkflowExecutionResponse (..),
    newSignalWorkflowExecutionResponse,
  )
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:/ 'newSignalWorkflowExecution' smart constructor.
data SignalWorkflowExecution = SignalWorkflowExecution'
  { -- | Data to attach to the @WorkflowExecutionSignaled@ event in the target
    -- workflow execution\'s history.
    SignalWorkflowExecution -> Maybe Text
input :: Prelude.Maybe Prelude.Text,
    -- | The runId of the workflow execution to signal.
    SignalWorkflowExecution -> Maybe Text
runId :: Prelude.Maybe Prelude.Text,
    -- | The name of the domain containing the workflow execution to signal.
    SignalWorkflowExecution -> Text
domain :: Prelude.Text,
    -- | The workflowId of the workflow execution to signal.
    SignalWorkflowExecution -> Text
workflowId :: Prelude.Text,
    -- | The name of the signal. This name must be meaningful to the target
    -- workflow.
    SignalWorkflowExecution -> Text
signalName :: Prelude.Text
  }
  deriving (SignalWorkflowExecution -> SignalWorkflowExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignalWorkflowExecution -> SignalWorkflowExecution -> Bool
$c/= :: SignalWorkflowExecution -> SignalWorkflowExecution -> Bool
== :: SignalWorkflowExecution -> SignalWorkflowExecution -> Bool
$c== :: SignalWorkflowExecution -> SignalWorkflowExecution -> Bool
Prelude.Eq, ReadPrec [SignalWorkflowExecution]
ReadPrec SignalWorkflowExecution
Int -> ReadS SignalWorkflowExecution
ReadS [SignalWorkflowExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SignalWorkflowExecution]
$creadListPrec :: ReadPrec [SignalWorkflowExecution]
readPrec :: ReadPrec SignalWorkflowExecution
$creadPrec :: ReadPrec SignalWorkflowExecution
readList :: ReadS [SignalWorkflowExecution]
$creadList :: ReadS [SignalWorkflowExecution]
readsPrec :: Int -> ReadS SignalWorkflowExecution
$creadsPrec :: Int -> ReadS SignalWorkflowExecution
Prelude.Read, Int -> SignalWorkflowExecution -> ShowS
[SignalWorkflowExecution] -> ShowS
SignalWorkflowExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignalWorkflowExecution] -> ShowS
$cshowList :: [SignalWorkflowExecution] -> ShowS
show :: SignalWorkflowExecution -> String
$cshow :: SignalWorkflowExecution -> String
showsPrec :: Int -> SignalWorkflowExecution -> ShowS
$cshowsPrec :: Int -> SignalWorkflowExecution -> ShowS
Prelude.Show, forall x. Rep SignalWorkflowExecution x -> SignalWorkflowExecution
forall x. SignalWorkflowExecution -> Rep SignalWorkflowExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SignalWorkflowExecution x -> SignalWorkflowExecution
$cfrom :: forall x. SignalWorkflowExecution -> Rep SignalWorkflowExecution x
Prelude.Generic)

-- |
-- Create a value of 'SignalWorkflowExecution' 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', 'signalWorkflowExecution_input' - Data to attach to the @WorkflowExecutionSignaled@ event in the target
-- workflow execution\'s history.
--
-- 'runId', 'signalWorkflowExecution_runId' - The runId of the workflow execution to signal.
--
-- 'domain', 'signalWorkflowExecution_domain' - The name of the domain containing the workflow execution to signal.
--
-- 'workflowId', 'signalWorkflowExecution_workflowId' - The workflowId of the workflow execution to signal.
--
-- 'signalName', 'signalWorkflowExecution_signalName' - The name of the signal. This name must be meaningful to the target
-- workflow.
newSignalWorkflowExecution ::
  -- | 'domain'
  Prelude.Text ->
  -- | 'workflowId'
  Prelude.Text ->
  -- | 'signalName'
  Prelude.Text ->
  SignalWorkflowExecution
newSignalWorkflowExecution :: Text -> Text -> Text -> SignalWorkflowExecution
newSignalWorkflowExecution
  Text
pDomain_
  Text
pWorkflowId_
  Text
pSignalName_ =
    SignalWorkflowExecution'
      { $sel:input:SignalWorkflowExecution' :: Maybe Text
input = forall a. Maybe a
Prelude.Nothing,
        $sel:runId:SignalWorkflowExecution' :: Maybe Text
runId = forall a. Maybe a
Prelude.Nothing,
        $sel:domain:SignalWorkflowExecution' :: Text
domain = Text
pDomain_,
        $sel:workflowId:SignalWorkflowExecution' :: Text
workflowId = Text
pWorkflowId_,
        $sel:signalName:SignalWorkflowExecution' :: Text
signalName = Text
pSignalName_
      }

-- | Data to attach to the @WorkflowExecutionSignaled@ event in the target
-- workflow execution\'s history.
signalWorkflowExecution_input :: Lens.Lens' SignalWorkflowExecution (Prelude.Maybe Prelude.Text)
signalWorkflowExecution_input :: Lens' SignalWorkflowExecution (Maybe Text)
signalWorkflowExecution_input = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SignalWorkflowExecution' {Maybe Text
input :: Maybe Text
$sel:input:SignalWorkflowExecution' :: SignalWorkflowExecution -> Maybe Text
input} -> Maybe Text
input) (\s :: SignalWorkflowExecution
s@SignalWorkflowExecution' {} Maybe Text
a -> SignalWorkflowExecution
s {$sel:input:SignalWorkflowExecution' :: Maybe Text
input = Maybe Text
a} :: SignalWorkflowExecution)

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

-- | The name of the domain containing the workflow execution to signal.
signalWorkflowExecution_domain :: Lens.Lens' SignalWorkflowExecution Prelude.Text
signalWorkflowExecution_domain :: Lens' SignalWorkflowExecution Text
signalWorkflowExecution_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SignalWorkflowExecution' {Text
domain :: Text
$sel:domain:SignalWorkflowExecution' :: SignalWorkflowExecution -> Text
domain} -> Text
domain) (\s :: SignalWorkflowExecution
s@SignalWorkflowExecution' {} Text
a -> SignalWorkflowExecution
s {$sel:domain:SignalWorkflowExecution' :: Text
domain = Text
a} :: SignalWorkflowExecution)

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

-- | The name of the signal. This name must be meaningful to the target
-- workflow.
signalWorkflowExecution_signalName :: Lens.Lens' SignalWorkflowExecution Prelude.Text
signalWorkflowExecution_signalName :: Lens' SignalWorkflowExecution Text
signalWorkflowExecution_signalName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SignalWorkflowExecution' {Text
signalName :: Text
$sel:signalName:SignalWorkflowExecution' :: SignalWorkflowExecution -> Text
signalName} -> Text
signalName) (\s :: SignalWorkflowExecution
s@SignalWorkflowExecution' {} Text
a -> SignalWorkflowExecution
s {$sel:signalName:SignalWorkflowExecution' :: Text
signalName = Text
a} :: SignalWorkflowExecution)

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

instance Prelude.Hashable SignalWorkflowExecution where
  hashWithSalt :: Int -> SignalWorkflowExecution -> Int
hashWithSalt Int
_salt SignalWorkflowExecution' {Maybe Text
Text
signalName :: Text
workflowId :: Text
domain :: Text
runId :: Maybe Text
input :: Maybe Text
$sel:signalName:SignalWorkflowExecution' :: SignalWorkflowExecution -> Text
$sel:workflowId:SignalWorkflowExecution' :: SignalWorkflowExecution -> Text
$sel:domain:SignalWorkflowExecution' :: SignalWorkflowExecution -> Text
$sel:runId:SignalWorkflowExecution' :: SignalWorkflowExecution -> Maybe Text
$sel:input:SignalWorkflowExecution' :: SignalWorkflowExecution -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
input
      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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
signalName

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

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

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

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

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

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

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