{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use replicateM" #-}

{- |

This module provides the core functionality for defining functions that can be
executed as Temporal workflows.

In day-to-day conversations, the term Workflow frequently denotes either a Workflow Type, a Workflow Definition, or a Workflow Execution.

= What is a Workflow Definition?

A Workflow Definition is the code that defines the constraints of a Workflow Execution.

A Workflow Definition is often also referred to as a Workflow Function. In Temporal's documentation, a Workflow Definition refers to the source for the instance of a Workflow Execution, while a Workflow Function refers to the source for the instance of a Workflow Function Execution.

A Workflow Execution effectively executes once to completion, while a Workflow Function Execution occurs many times during the life of a Workflow Execution.

= Deterministic constraints

A critical aspect of developing Workflow Definitions is ensuring they exhibit certain deterministic traits – that is, making sure that the same Commands are emitted in the same sequence, whenever a corresponding Workflow Function Execution (instance of the Function Definition) is re-executed.

The execution semantics of a Workflow Execution include the re-execution of a Workflow Function, which is called a Replay. The use of Workflow APIs in the function is what generates Commands. Commands tell the Cluster which Events to create and add to the Workflow Execution's Event History. When a Workflow Function executes, the Commands that are emitted are compared with the existing Event History. If a corresponding Event already exists within the Event History that maps to the generation of that Command in the same sequence, and some specific metadata of that Command matches with some specific metadata of the Event, then the Function Execution progresses.

For example, using an SDK's "Execute Activity" API generates the ScheduleActivityTask Command. When this API is called upon re-execution, that Command is compared with the Event that is in the same location within the sequence. The Event in the sequence must be an ActivityTaskScheduled Event, where the Activity name is the same as what is in the Command.

If a generated Command doesn't match what it needs to in the existing Event History, then the Workflow Execution returns a non-deterministic error.

The following are the two reasons why a Command might be generated out of sequence or the wrong Command might be generated altogether:

- Code changes are made to a Workflow Definition that is in use by a running Workflow Execution.
- There is intrinsic non-deterministic logic (such as inline random branching).

= Code changes can cause non-deterministic behavior

The Workflow Definition can change in very limited ways once there is a Workflow Execution depending on it. To alleviate non-deterministic issues that arise from code changes, we recommend using Workflow Versioning.

For example, let's say we have a Workflow Definition that defines the following sequence:

1. Start and wait on a Timer/sleep.
2. Spawn and wait on an Activity Execution.
3. Complete.

We start a Worker and spawn a Workflow Execution that uses that Workflow Definition. The Worker would emit the StartTimer Command and the Workflow Execution would become suspended.

Before the Timer is up, we change the Workflow Definition to the following sequence:

1. Spawn and wait on an Activity Execution.
2. Start and wait on a Timer/sleep.
3. Complete.

When the Timer fires, the next Workflow Task will cause the Workflow Function to re-execute. The first Command the Worker sees would be ScheduleActivityTask Command, which wouldn't match up to the expected TimerStarted Event.

The Workflow Execution would fail and return a non-deterministic error.

The following are examples of minor changes that would not result in non-determinism errors when re-executing a History which already contain the Events:

- Changing the duration of a Timer
- Changing the arguments to:

    * The Activity Options in a call to spawn an Activity Execution (local or nonlocal).
    * The Child Workflow Options in a call to spawn a Child Workflow Execution.
    * Call to Signal an External Workflow Execution.

- Adding a Signal Handler for a Signal Type that has not been sent to this Workflow Execution.

= Workflow Versioning

Note: not yet implemented

The Workflow Versioning feature enables the creation of logical branching inside a Workflow Definition based on a developer specified version identifier. This feature is useful for Workflow Definition logic needs to be updated, but there are running Workflow Executions that currently depends on it. It is important to note that a practical way to handle different versions of Workflow Definitions, without using the versioning API, is to run the different versions on separate Task Queues.

= Handling unreliable Worker Processes

You do not handle Worker Process failure or restarts in a Workflow Definition.

Workflow Function Executions are completely oblivious to the Worker Process in terms of failures or downtime. The Temporal Platform ensures that the state of a Workflow Execution is recovered and progress resumes if there is an outage of either Worker Processes or the Temporal Cluster itself. The only reason a Workflow Execution might fail is due to the code throwing an error or exception, not because of underlying infrastructure outages.
-}
module Temporal.Workflow (
  Workflow,
  WorkflowDefinition (..),
  KnownWorkflow (..),
  ProvidedWorkflow (..),
  provideWorkflow,
  Task,
  StartToClose (..),
  ScheduleToClose (..),
  These (..),

  -- * Workflow monad operations
  -- $workflowBasics

  -- ** Activity operations
  -- $activityBasics
  ActivityRef (..),
  KnownActivity (..),
  StartActivityOptions (..), -- TODO fields conflict
  ActivityCancellationType (..),
  ActivityTimeoutPolicy (..),
  StartActivityTimeoutOption (..),
  defaultStartActivityOptions,
  startActivity,
  executeActivity,
  StartLocalActivityOptions (..),
  defaultStartLocalActivityOptions,
  startLocalActivity,

  -- ** Child workflow operations
  -- $childWorkflow
  StartChildWorkflowOptions (..),
  defaultChildWorkflowOptions,
  WorkflowRef (..),
  startChildWorkflow,
  executeChildWorkflow,
  ChildWorkflowHandle,
  Wait (..),
  Cancel (..),
  WorkflowHandle (..),
  waitChildWorkflowResult,
  waitChildWorkflowStart,
  cancelChildWorkflowExecution,
  ExternalWorkflowHandle,
  getExternalWorkflowHandle,
  Info (..),
  RetryPolicy (..),
  defaultRetryPolicy,
  ParentInfo (..),

  -- * Workflow metadata

  --
  info,
  getMemoValues,
  lookupMemoValue,
  upsertSearchAttributes,

  -- * Versioning workflows
  -- $versioning
  patched,
  deprecatePatch,

  -- * Concurrency within Workflows
  Temporal.Workflow.race,
  Temporal.Workflow.race_,
  Temporal.Workflow.concurrently,
  Temporal.Workflow.concurrently_,
  Temporal.Workflow.mapConcurrently,
  Temporal.Workflow.mapConcurrently_,
  Temporal.Workflow.replicateConcurrently,
  Temporal.Workflow.replicateConcurrently_,
  Temporal.Workflow.forConcurrently,
  Temporal.Workflow.forConcurrently_,
  traverseConcurrently,
  traverseConcurrently_,
  sequenceConcurrently,
  sequenceConcurrently_,
  ConcurrentWorkflow (..),
  independently,
  biselect,
  biselectOpt,

  -- * Interacting with running Workflows

  -- ** Queries
  -- $queries
  QueryRef (..),
  Query,
  KnownQuery (..),
  setQueryHandler,

  -- ** Signals
  -- $signals
  SignalRef (..),
  KnownSignal (..),
  setSignalHandler,
  ValidSignalHandler,
  Condition,
  waitCondition,

  -- * Other utilities
  unsafeAsyncEffectSink,

  -- * State vars
  StateVar,
  newStateVar,
  MonadReadStateVar (..),
  MonadWriteStateVar (..),

  -- * Time and timers
  now,
  time,
  sleep,
  Timer,
  createTimer,
  scheduledTime,

  -- * Workflow cancellation
  isCancelRequested,
  waitCancellation,

  -- * Random value generation
  -- $randomness
  randomGen,
  uuid4,
  uuid7,
  WorkflowGenM,

  -- * Continue as new
  ContinueAsNewOptions (..), -- TODO, fields conflict
  defaultContinueAsNewOptions,
  Temporal.Workflow.continueAsNew,

  -- * Type definitions
  GatherArgs,
  ActivityId (..),
  WorkflowId (..),
  Namespace (..),
  TaskQueue (..),
  PatchId (..),
  RunId (..),
  ParentClosePolicy (..),
  ChildWorkflowCancellationType (..),
  WorkflowIdReusePolicy (..),
  WorkflowType (..),
  RequireCallStack,
  TimeoutOptions (..),
  defaultTimeoutOptions,

  -- * Commonly used
  (:->:),
) where

import Control.Applicative (Alternative (..))
import Control.Concurrent (forkIO)
import Control.Exception.Annotated (throwWithCallStack)
import Control.Monad
import Control.Monad.Catch
import Control.Monad.Logger
import Control.Monad.Reader
import qualified Data.Bits as Bits
import qualified Data.ByteString.Short as SBS
import Data.Coerce
import Data.Foldable (Foldable (..), traverse_)
import qualified Data.HashMap.Strict as HashMap
import Data.Int (Int64)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.ProtoLens
import Data.Proxy
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as Text
import Data.These (These (..))
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.System (SystemTime (..), systemToUTCTime)
import Data.Time.Format
import Data.UUID (UUID)
import qualified Data.UUID as UUID
import Data.UUID.Types.Internal (buildFromBytes)
import Data.Vector (Vector)
import qualified Data.Vector as V
import Data.Word (Word32, Word64, Word8)
import GHC.Stack
import Lens.Family2
import qualified Proto.Temporal.Api.Common.V1.Message_Fields as Payloads
import qualified Proto.Temporal.Api.Failure.V1.Message_Fields as Failure
import qualified Proto.Temporal.Sdk.Core.ActivityResult.ActivityResult as ActivityResult
import qualified Proto.Temporal.Sdk.Core.ActivityResult.ActivityResult_Fields as ActivityResult
import qualified Proto.Temporal.Sdk.Core.Common.Common_Fields as Common
import qualified Proto.Temporal.Sdk.Core.WorkflowActivation.WorkflowActivation_Fields as Activation
import qualified Proto.Temporal.Sdk.Core.WorkflowCommands.WorkflowCommands as Command
import qualified Proto.Temporal.Sdk.Core.WorkflowCommands.WorkflowCommands_Fields as Command
import RequireCallStack
import System.Random.Stateful
import Temporal.Activity.Definition (ActivityRef (..), KnownActivity (..))
import Temporal.Common
import Temporal.Common.TimeoutType
import Temporal.Duration (Duration (..), durationFromProto, durationToProto, nanoseconds, seconds)
import Temporal.Exception
import Temporal.Payload
import Temporal.SearchAttributes
import Temporal.SearchAttributes.Internal
import Temporal.Workflow.Definition
import Temporal.Workflow.Internal.Monad
import Temporal.Workflow.Query
import Temporal.Workflow.Signal
import Temporal.Workflow.Types
import Temporal.Workflow.Unsafe.Handle
import Temporal.Workflow.WorkflowInstance
import Temporal.WorkflowInstance
import UnliftIO


-- class MonadWorkflow m where
-- startChildWorkflowFromPayloads :: forall args result. RequireCallStack => KnownWorkflow args result -> StartChildWorkflowOptions -> [IO Payload] -> m (ChildWorkflowHandle result)
-- startActivityFromPayloads :: forall args result. RequireCallStack => KnownActivity args result -> StartActivityOptions -> [IO Payload] -> m (Task result)
-- askInfo :: m Info
-- getMemoValues :: m (Map Text Payload)
-- upsertSearchAttributes :: RequireCallStack => Map Text SearchAttributeType -> m ()
-- applyPatch :: RequireCallStack => PatchId -> Bool -> m Bool
-- randomGen :: m StdGen
-- uuid4 :: m UUID
-- setQueryHandler
-- setSignalHandler
-- time
-- createTimer
-- continueAsNew
-- getExternalWorkflowHandle
-- waitCondition
-- unsafeEffectSink

newtype WorkflowInternal a = WorkflowInternal (ReaderT ContinuationEnv InstanceM a)
  deriving newtype ((forall a b. (a -> b) -> WorkflowInternal a -> WorkflowInternal b)
-> (forall a b. a -> WorkflowInternal b -> WorkflowInternal a)
-> Functor WorkflowInternal
forall a b. a -> WorkflowInternal b -> WorkflowInternal a
forall a b. (a -> b) -> WorkflowInternal a -> WorkflowInternal b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WorkflowInternal a -> WorkflowInternal b
fmap :: forall a b. (a -> b) -> WorkflowInternal a -> WorkflowInternal b
$c<$ :: forall a b. a -> WorkflowInternal b -> WorkflowInternal a
<$ :: forall a b. a -> WorkflowInternal b -> WorkflowInternal a
Functor, Functor WorkflowInternal
Functor WorkflowInternal =>
(forall a. a -> WorkflowInternal a)
-> (forall a b.
    WorkflowInternal (a -> b)
    -> WorkflowInternal a -> WorkflowInternal b)
-> (forall a b c.
    (a -> b -> c)
    -> WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal c)
-> (forall a b.
    WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal b)
-> (forall a b.
    WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal a)
-> Applicative WorkflowInternal
forall a. a -> WorkflowInternal a
forall a b.
WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal a
forall a b.
WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal b
forall a b.
WorkflowInternal (a -> b)
-> WorkflowInternal a -> WorkflowInternal b
forall a b c.
(a -> b -> c)
-> WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> WorkflowInternal a
pure :: forall a. a -> WorkflowInternal a
$c<*> :: forall a b.
WorkflowInternal (a -> b)
-> WorkflowInternal a -> WorkflowInternal b
<*> :: forall a b.
WorkflowInternal (a -> b)
-> WorkflowInternal a -> WorkflowInternal b
$cliftA2 :: forall a b c.
(a -> b -> c)
-> WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal c
liftA2 :: forall a b c.
(a -> b -> c)
-> WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal c
$c*> :: forall a b.
WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal b
*> :: forall a b.
WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal b
$c<* :: forall a b.
WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal a
<* :: forall a b.
WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal a
Applicative, Applicative WorkflowInternal
Applicative WorkflowInternal =>
(forall a b.
 WorkflowInternal a
 -> (a -> WorkflowInternal b) -> WorkflowInternal b)
-> (forall a b.
    WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal b)
-> (forall a. a -> WorkflowInternal a)
-> Monad WorkflowInternal
forall a. a -> WorkflowInternal a
forall a b.
WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal b
forall a b.
WorkflowInternal a
-> (a -> WorkflowInternal b) -> WorkflowInternal b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b.
WorkflowInternal a
-> (a -> WorkflowInternal b) -> WorkflowInternal b
>>= :: forall a b.
WorkflowInternal a
-> (a -> WorkflowInternal b) -> WorkflowInternal b
$c>> :: forall a b.
WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal b
>> :: forall a b.
WorkflowInternal a -> WorkflowInternal b -> WorkflowInternal b
$creturn :: forall a. a -> WorkflowInternal a
return :: forall a. a -> WorkflowInternal a
Monad, Monad WorkflowInternal
Monad WorkflowInternal =>
(forall a. IO a -> WorkflowInternal a) -> MonadIO WorkflowInternal
forall a. IO a -> WorkflowInternal a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> WorkflowInternal a
liftIO :: forall a. IO a -> WorkflowInternal a
MonadIO)


-- | We need a specialized version of 'withArgs' since we aren't supposed to introduce arbitrary effects in the 'Workflow' monad.
withWorkflowArgs :: forall args result codec. (VarArgs args, AllArgs (Codec codec) args) => codec -> (V.Vector Payload -> Workflow result) -> args :->: Workflow result
withWorkflowArgs :: forall (args :: [*]) result codec.
(VarArgs args, AllArgs (Codec codec) args) =>
codec
-> (Vector Payload -> Workflow result) -> args :->: Workflow result
withWorkflowArgs codec
c Vector Payload -> Workflow result
f =
  forall (args :: [*]) result result'.
VarArgs args =>
(result -> result') -> (args :->: result) -> args :->: result'
mapResult
    @args
    @(WorkflowInternal (Result result))
    @(Workflow result)
    WorkflowInternal (Result result) -> Workflow result
forall a. WorkflowInternal (Result a) -> Workflow a
safely
    ((args :->: WorkflowInternal (Result result))
 -> args :->: Workflow result)
-> (args :->: WorkflowInternal (Result result))
-> args :->: Workflow result
forall a b. (a -> b) -> a -> b
$ forall (args :: [*]) result codec.
(VarArgs args, AllArgs (Codec codec) args) =>
codec -> (Vector UnencodedPayload -> result) -> args :->: result
withArgs @args @(WorkflowInternal (Result result)) codec
c
    ((Vector UnencodedPayload -> WorkflowInternal (Result result))
 -> args :->: WorkflowInternal (Result result))
-> (Vector UnencodedPayload -> WorkflowInternal (Result result))
-> args :->: WorkflowInternal (Result result)
forall a b. (a -> b) -> a -> b
$ \Vector UnencodedPayload
args -> do
      args' <- IO (Vector Payload) -> WorkflowInternal (Vector Payload)
forall a. IO a -> WorkflowInternal a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Vector Payload) -> WorkflowInternal (Vector Payload))
-> IO (Vector Payload) -> WorkflowInternal (Vector Payload)
forall a b. (a -> b) -> a -> b
$ Vector UnencodedPayload -> IO (Vector Payload)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Vector (m a) -> m (Vector a)
sequence Vector UnencodedPayload
args
      unsafely $ f args'
  where
    unsafely :: Workflow a -> WorkflowInternal (Result a)
    unsafely :: forall a. Workflow a -> WorkflowInternal (Result a)
unsafely = Workflow a -> WorkflowInternal (Result a)
forall a b. Coercible a b => a -> b
coerce
    safely :: WorkflowInternal (Result a) -> Workflow a
    safely :: forall a. WorkflowInternal (Result a) -> Workflow a
safely = WorkflowInternal (Result a) -> Workflow a
forall a b. Coercible a b => a -> b
coerce


{- $activityBasics

An Activity is an IO-based function that executes a single, well-defined action (either short or long running),
such as calling another service, transcoding a media file, or sending an email message.
Activity code can be non-deterministic.

We recommend that it be idempotent.

Workflow code orchestrates the execution of Activities, persisting the results.
If an Activity Function Execution fails, any future execution starts from initial state (except Heartbeats).

Activity Functions are executed by Worker Processes. When the Activity Function returns,
the Worker sends the results back to the Temporal Cluster as part of the ActivityTaskCompleted Event.
The Event is added to the Workflow Execution's Event History.
-}


startActivityFromPayloads
  :: forall args result
   . RequireCallStack
  => KnownActivity args result
  -> StartActivityOptions
  -> Vector Payload
  -> Workflow (Task result)
startActivityFromPayloads :: forall (args :: [*]) result.
RequireCallStack =>
KnownActivity args result
-> StartActivityOptions -> Vector Payload -> Workflow (Task result)
startActivityFromPayloads (KnownActivity codec
codec Text
name) StartActivityOptions
opts Vector Payload
typedPayloads = InstanceM (Task result) -> Workflow (Task result)
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM (Task result) -> Workflow (Task result))
-> InstanceM (Task result) -> Workflow (Task result)
forall a b. (a -> b) -> a -> b
$ do
  runInIO <- InstanceM (InstanceM (Task Payload) -> IO (Task Payload))
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
  updateCallStack
  inst <- ask
  let intercept :: ActivityInput -> (ActivityInput -> IO (Task Payload)) -> IO (Task Payload)
      intercept = WorkflowInstance
inst.outboundInterceptor.scheduleActivity
  s@(Sequence actSeq) <- nextActivitySequence
  rawTask <- liftIO $ intercept (ActivityInput name typedPayloads opts s) $ \ActivityInput
activityInput -> InstanceM (Task Payload) -> IO (Task Payload)
runInIO (InstanceM (Task Payload) -> IO (Task Payload))
-> InstanceM (Task Payload) -> IO (Task Payload)
forall a b. (a -> b) -> a -> b
$ do
    resultSlot <- InstanceM (IVar ResolveActivity)
forall (m :: * -> *) a. MonadIO m => m (IVar a)
newIVar
    atomically $ modifyTVar' inst.workflowSequenceMaps $ \SequenceMaps
seqMaps ->
      SequenceMaps
seqMaps {activities = HashMap.insert s resultSlot (activities seqMaps)}

    i <- readIORef inst.workflowInstanceInfo
    hdrs <- processorEncodePayloads inst.payloadProcessor activityInput.options.headers
    args <- processorEncodePayloads inst.payloadProcessor activityInput.args
    let actId = Text -> (ActivityId -> Text) -> Maybe ActivityId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Word32 -> String
forall a. Show a => a -> String
show Word32
actSeq) ActivityId -> Text
rawActivityId (ActivityInput
activityInput.options.activityId)
        scheduleActivity =
          ScheduleActivity
forall msg. Message msg => msg
defMessage
            ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity Word32
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "seq" a) =>
LensLike' f s a
Command.seq (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity Word32)
-> Word32 -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ Word32
actSeq
            ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity Text
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity Text
forall (f :: * -> *) s a.
(Functor f, HasField s "activityId" a) =>
LensLike' f s a
Command.activityId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity Text)
-> Text -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
actId
            ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity Text
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity Text
forall (f :: * -> *) s a.
(Functor f, HasField s "activityType" a) =>
LensLike' f s a
Command.activityType (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity Text)
-> Text -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ ActivityInput
activityInput.activityType
            ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity Text
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity Text
forall (f :: * -> *) s a.
(Functor f, HasField s "taskQueue" a) =>
LensLike' f s a
Command.taskQueue (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity Text)
-> Text -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ TaskQueue -> Text
rawTaskQueue (TaskQueue -> Maybe TaskQueue -> TaskQueue
forall a. a -> Maybe a -> a
fromMaybe Info
i.taskQueue ActivityInput
activityInput.options.taskQueue)
            ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity (Map Text Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity (Map Text Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "headers" a) =>
LensLike' f s a
Command.headers (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity (Map Text Payload))
-> Map Text Payload -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Payload -> Payload) -> Map Text Payload -> Map Text Payload
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertToProtoPayload Map Text Payload
hdrs
            ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity (Vector Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity (Vector Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "vec'arguments" a) =>
LensLike' f s a
Command.vec'arguments (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity (Vector Payload))
-> Vector Payload -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Payload -> Payload) -> Vector Payload -> Vector Payload
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertToProtoPayload Vector Payload
args
            ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity (Maybe RetryPolicy)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity (Maybe RetryPolicy)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'retryPolicy" a) =>
LensLike' f s a
Command.maybe'retryPolicy (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity (Maybe RetryPolicy))
-> Maybe RetryPolicy -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ (RetryPolicy -> RetryPolicy)
-> Maybe RetryPolicy -> Maybe RetryPolicy
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RetryPolicy -> RetryPolicy
retryPolicyToProto ActivityInput
activityInput.options.retryPolicy
            ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity ActivityCancellationType
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity ActivityCancellationType
forall (f :: * -> *) s a.
(Functor f, HasField s "cancellationType" a) =>
LensLike' f s a
Command.cancellationType (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity ActivityCancellationType)
-> ActivityCancellationType -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ ActivityCancellationType -> ActivityCancellationType
activityCancellationTypeToProto ActivityInput
activityInput.options.cancellationType
            ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'scheduleToStartTimeout" a) =>
LensLike' f s a
Command.maybe'scheduleToStartTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity (Maybe Duration))
-> Maybe Duration -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationToProto ActivityInput
activityInput.options.scheduleToStartTimeout
            ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'heartbeatTimeout" a) =>
LensLike' f s a
Command.maybe'heartbeatTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity (Maybe Duration))
-> Maybe Duration -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationToProto ActivityInput
activityInput.options.heartbeatTimeout
            ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& \ScheduleActivity
msg ->
              case ActivityInput
activityInput.options.timeout of
                StartToCloseTimeout Duration
t -> ScheduleActivity
msg ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity Duration
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity Duration
forall (f :: * -> *) s a.
(Functor f, HasField s "startToCloseTimeout" a) =>
LensLike' f s a
Command.startToCloseTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity Duration)
-> Duration -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ Duration -> Duration
durationToProto Duration
t
                ScheduleToCloseTimeout Duration
t -> ScheduleActivity
msg ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity Duration
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity Duration
forall (f :: * -> *) s a.
(Functor f, HasField s "scheduleToCloseTimeout" a) =>
LensLike' f s a
Command.scheduleToCloseTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity Duration)
-> Duration -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ Duration -> Duration
durationToProto Duration
t
                StartToCloseAndScheduleToCloseTimeout Duration
stc Duration
stc' ->
                  ScheduleActivity
msg
                    ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity Duration
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity Duration
forall (f :: * -> *) s a.
(Functor f, HasField s "startToCloseTimeout" a) =>
LensLike' f s a
Command.startToCloseTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity Duration)
-> Duration -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ Duration -> Duration
durationToProto Duration
stc
                    ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity Duration
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity Duration
forall (f :: * -> *) s a.
(Functor f, HasField s "scheduleToCloseTimeout" a) =>
LensLike' f s a
Command.scheduleToCloseTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity Duration)
-> Duration -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ Duration -> Duration
durationToProto Duration
stc'
                ScheduleActivity
-> (ScheduleActivity -> ScheduleActivity) -> ScheduleActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleActivity Bool
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleActivity Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "doNotEagerlyExecute" a) =>
LensLike' f s a
Command.doNotEagerlyExecute (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleActivity Bool)
-> Bool -> ScheduleActivity -> ScheduleActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ ActivityInput
activityInput.options.disableEagerExecution

    let cmd = WorkflowCommand
forall msg. Message msg => msg
defMessage WorkflowCommand
-> (WorkflowCommand -> WorkflowCommand) -> WorkflowCommand
forall s t. s -> (s -> t) -> t
& LensLike' f WorkflowCommand ScheduleActivity
forall {f :: * -> *}.
Identical f =>
LensLike' f WorkflowCommand ScheduleActivity
forall (f :: * -> *) s a.
(Functor f, HasField s "scheduleActivity" a) =>
LensLike' f s a
Command.scheduleActivity (forall {f :: * -> *}.
 Identical f =>
 LensLike' f WorkflowCommand ScheduleActivity)
-> ScheduleActivity -> WorkflowCommand -> WorkflowCommand
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleActivity
scheduleActivity
    addCommand cmd
    pure $
      Task
        { waitAction = do
            res <- getIVar resultSlot
            $(logInfo) ("Activity result: " <> Text.pack (show res))
            Workflow $ \ContinuationEnv
_ -> case ResolveActivity
res ResolveActivity
-> FoldLike
     (Maybe ActivityResolution'Status)
     ResolveActivity
     ResolveActivity
     (Maybe ActivityResolution'Status)
     (Maybe ActivityResolution'Status)
-> Maybe ActivityResolution'Status
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike'
  (Constant (Maybe ActivityResolution'Status))
  ResolveActivity
  ActivityResolution
forall (f :: * -> *) s a.
(Functor f, HasField s "result" a) =>
LensLike' f s a
Activation.result LensLike'
  (Constant (Maybe ActivityResolution'Status))
  ResolveActivity
  ActivityResolution
-> ((Maybe ActivityResolution'Status
     -> Constant
          (Maybe ActivityResolution'Status)
          (Maybe ActivityResolution'Status))
    -> ActivityResolution
    -> Constant (Maybe ActivityResolution'Status) ActivityResolution)
-> FoldLike
     (Maybe ActivityResolution'Status)
     ResolveActivity
     ResolveActivity
     (Maybe ActivityResolution'Status)
     (Maybe ActivityResolution'Status)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ActivityResolution'Status
 -> Constant
      (Maybe ActivityResolution'Status)
      (Maybe ActivityResolution'Status))
-> ActivityResolution
-> Constant (Maybe ActivityResolution'Status) ActivityResolution
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'status" a) =>
LensLike' f s a
ActivityResult.maybe'status of
              Maybe ActivityResolution'Status
Nothing -> String -> InstanceM (Result Payload)
forall a. HasCallStack => String -> a
error String
"Activity result missing status"
              Just (ActivityResult.ActivityResolution'Completed Success
success) -> do
                res <- IO (Either String Payload) -> InstanceM (Either String Payload)
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String Payload) -> InstanceM (Either String Payload))
-> IO (Either String Payload) -> InstanceM (Either String Payload)
forall a b. (a -> b) -> a -> b
$ PayloadProcessor -> Payload -> IO (Either String Payload)
payloadProcessorDecode WorkflowInstance
inst.payloadProcessor (Payload -> IO (Either String Payload))
-> Payload -> IO (Either String Payload)
forall a b. (a -> b) -> a -> b
$ Payload -> Payload
convertFromProtoPayload (Success
success Success
-> FoldLike Payload Success Success Payload Payload -> Payload
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Payload Success Success Payload Payload
forall (f :: * -> *) s a.
(Functor f, HasField s "result" a) =>
LensLike' f s a
ActivityResult.result)
                pure $ case res of
                  Left String
err -> SomeException -> Result Payload
forall a. SomeException -> Result a
Throw (SomeException -> Result Payload)
-> SomeException -> Result Payload
forall a b. (a -> b) -> a -> b
$ ValueError -> SomeException
forall e. Exception e => e -> SomeException
toException (ValueError -> SomeException) -> ValueError -> SomeException
forall a b. (a -> b) -> a -> b
$ String -> ValueError
ValueError String
err
                  Right Payload
val -> Payload -> Result Payload
forall a. a -> Result a
Done Payload
val
              Just (ActivityResult.ActivityResolution'Failed Failure
failure_) ->
                let failure :: Failure
failure = Failure
failure_ Failure
-> FoldLike Failure Failure Failure Failure Failure -> Failure
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Failure Failure Failure Failure Failure
forall (f :: * -> *) s a.
(Functor f, HasField s "failure" a) =>
LensLike' f s a
ActivityResult.failure
                in Result Payload -> InstanceM (Result Payload)
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result Payload -> InstanceM (Result Payload))
-> Result Payload -> InstanceM (Result Payload)
forall a b. (a -> b) -> a -> b
$
                    SomeException -> Result Payload
forall a. SomeException -> Result a
Throw (SomeException -> Result Payload)
-> SomeException -> Result Payload
forall a b. (a -> b) -> a -> b
$
                      ActivityFailure -> SomeException
forall e. Exception e => e -> SomeException
toException (ActivityFailure -> SomeException)
-> ActivityFailure -> SomeException
forall a b. (a -> b) -> a -> b
$
                        ActivityFailure
                          { message :: Text
message = Failure
failure Failure -> FoldLike Text Failure Failure Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text Failure Failure Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "message" a) =>
LensLike' f s a
Failure.message
                          , activityType :: ActivityType
activityType = Text -> ActivityType
ActivityType ActivityInput
activityInput.activityType
                          , activityId :: ActivityId
activityId = Text -> ActivityId
ActivityId Text
actId
                          , retryState :: RetryState
retryState = RetryState -> RetryState
retryStateFromProto (RetryState -> RetryState) -> RetryState -> RetryState
forall a b. (a -> b) -> a -> b
$ Failure
failure Failure
-> FoldLike RetryState Failure Failure RetryState RetryState
-> RetryState
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant RetryState) Failure ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "activityFailureInfo" a) =>
LensLike' f s a
Failure.activityFailureInfo LensLike' (Constant RetryState) Failure ActivityFailureInfo
-> ((RetryState -> Constant RetryState RetryState)
    -> ActivityFailureInfo -> Constant RetryState ActivityFailureInfo)
-> FoldLike RetryState Failure Failure RetryState RetryState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RetryState -> Constant RetryState RetryState)
-> ActivityFailureInfo -> Constant RetryState ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "retryState" a) =>
LensLike' f s a
Failure.retryState
                          , identity :: Text
identity = Failure
failure Failure -> FoldLike Text Failure Failure Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant Text) Failure ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "activityFailureInfo" a) =>
LensLike' f s a
Failure.activityFailureInfo LensLike' (Constant Text) Failure ActivityFailureInfo
-> ((Text -> Constant Text Text)
    -> ActivityFailureInfo -> Constant Text ActivityFailureInfo)
-> FoldLike Text Failure Failure Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Constant Text Text)
-> ActivityFailureInfo -> Constant Text ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "identity" a) =>
LensLike' f s a
Failure.identity
                          , cause :: ApplicationFailure
cause =
                              let cause_ :: Failure
cause_ = Failure
failure Failure
-> FoldLike Failure Failure Failure Failure Failure -> Failure
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Failure Failure Failure Failure Failure
forall (f :: * -> *) s a.
(Functor f, HasField s "cause" a) =>
LensLike' f s a
Failure.cause
                              in ApplicationFailure
                                  { type' :: Text
type' = Failure
cause_ Failure -> FoldLike Text Failure Failure Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant Text) Failure ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "applicationFailureInfo" a) =>
LensLike' f s a
Failure.applicationFailureInfo LensLike' (Constant Text) Failure ApplicationFailureInfo
-> ((Text -> Constant Text Text)
    -> ApplicationFailureInfo -> Constant Text ApplicationFailureInfo)
-> FoldLike Text Failure Failure Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Constant Text Text)
-> ApplicationFailureInfo -> Constant Text ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "type'" a) =>
LensLike' f s a
Failure.type'
                                  , message :: Text
message = Failure
cause_ Failure -> FoldLike Text Failure Failure Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text Failure Failure Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "message" a) =>
LensLike' f s a
Failure.message
                                  , nonRetryable :: Bool
nonRetryable = Failure
cause_ Failure -> FoldLike Bool Failure Failure Bool Bool -> Bool
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant Bool) Failure ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "applicationFailureInfo" a) =>
LensLike' f s a
Failure.applicationFailureInfo LensLike' (Constant Bool) Failure ApplicationFailureInfo
-> ((Bool -> Constant Bool Bool)
    -> ApplicationFailureInfo -> Constant Bool ApplicationFailureInfo)
-> FoldLike Bool Failure Failure Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Constant Bool Bool)
-> ApplicationFailureInfo -> Constant Bool ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "nonRetryable" a) =>
LensLike' f s a
Failure.nonRetryable
                                  , details :: [Payload]
details = Failure
cause_ Failure
-> FoldLike [Payload] Failure Failure [Payload] Any -> [Payload]
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant [Payload]) Failure ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "applicationFailureInfo" a) =>
LensLike' f s a
Failure.applicationFailureInfo LensLike' (Constant [Payload]) Failure ApplicationFailureInfo
-> (([Payload] -> Constant [Payload] Any)
    -> ApplicationFailureInfo
    -> Constant [Payload] ApplicationFailureInfo)
-> FoldLike [Payload] Failure Failure [Payload] Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike' (Constant [Payload]) ApplicationFailureInfo Payloads
forall (f :: * -> *) s a.
(Functor f, HasField s "details" a) =>
LensLike' f s a
Failure.details LensLike' (Constant [Payload]) ApplicationFailureInfo Payloads
-> (([Payload] -> Constant [Payload] Any)
    -> Payloads -> Constant [Payload] Payloads)
-> ([Payload] -> Constant [Payload] Any)
-> ApplicationFailureInfo
-> Constant [Payload] ApplicationFailureInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike' (Constant [Payload]) Payloads [Payload]
forall (f :: * -> *) s a.
(Functor f, HasField s "payloads" a) =>
LensLike' f s a
Payloads.payloads LensLike' (Constant [Payload]) Payloads [Payload]
-> (([Payload] -> Constant [Payload] Any)
    -> [Payload] -> Constant [Payload] [Payload])
-> ([Payload] -> Constant [Payload] Any)
-> Payloads
-> Constant [Payload] Payloads
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Payload] -> [Payload])
-> Getter [Payload] [Payload] [Payload] Any
forall s a t b. (s -> a) -> Getter s t a b
to ((Payload -> Payload) -> [Payload] -> [Payload]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertFromProtoPayload)
                                  , stack :: Text
stack = Failure
cause_ Failure -> FoldLike Text Failure Failure Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text Failure Failure Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "stackTrace" a) =>
LensLike' f s a
Failure.stackTrace
                                  , nextRetryDelay :: Maybe Duration
nextRetryDelay = (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationFromProto (Failure
cause_ Failure
-> FoldLike
     (Maybe Duration) Failure Failure (Maybe Duration) (Maybe Duration)
-> Maybe Duration
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike'
  (Constant (Maybe Duration)) Failure ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "applicationFailureInfo" a) =>
LensLike' f s a
Failure.applicationFailureInfo LensLike'
  (Constant (Maybe Duration)) Failure ApplicationFailureInfo
-> ((Maybe Duration -> Constant (Maybe Duration) (Maybe Duration))
    -> ApplicationFailureInfo
    -> Constant (Maybe Duration) ApplicationFailureInfo)
-> FoldLike
     (Maybe Duration) Failure Failure (Maybe Duration) (Maybe Duration)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Duration -> Constant (Maybe Duration) (Maybe Duration))
-> ApplicationFailureInfo
-> Constant (Maybe Duration) ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'nextRetryDelay" a) =>
LensLike' f s a
Failure.maybe'nextRetryDelay)
                                  }
                          , scheduledEventId :: Int64
scheduledEventId = Failure
failure Failure -> FoldLike Int64 Failure Failure Int64 Int64 -> Int64
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant Int64) Failure ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "activityFailureInfo" a) =>
LensLike' f s a
Failure.activityFailureInfo LensLike' (Constant Int64) Failure ActivityFailureInfo
-> ((Int64 -> Constant Int64 Int64)
    -> ActivityFailureInfo -> Constant Int64 ActivityFailureInfo)
-> FoldLike Int64 Failure Failure Int64 Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Constant Int64 Int64)
-> ActivityFailureInfo -> Constant Int64 ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "scheduledEventId" a) =>
LensLike' f s a
Failure.scheduledEventId
                          , startedEventId :: Int64
startedEventId = Failure
failure Failure -> FoldLike Int64 Failure Failure Int64 Int64 -> Int64
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant Int64) Failure ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "activityFailureInfo" a) =>
LensLike' f s a
Failure.activityFailureInfo LensLike' (Constant Int64) Failure ActivityFailureInfo
-> ((Int64 -> Constant Int64 Int64)
    -> ActivityFailureInfo -> Constant Int64 ActivityFailureInfo)
-> FoldLike Int64 Failure Failure Int64 Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Constant Int64 Int64)
-> ActivityFailureInfo -> Constant Int64 ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "startedEventId" a) =>
LensLike' f s a
Failure.startedEventId
                          , original :: ActivityFailureInfo
original = Failure
failure Failure
-> FoldLike
     ActivityFailureInfo
     Failure
     Failure
     ActivityFailureInfo
     ActivityFailureInfo
-> ActivityFailureInfo
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  ActivityFailureInfo
  Failure
  Failure
  ActivityFailureInfo
  ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "activityFailureInfo" a) =>
LensLike' f s a
Failure.activityFailureInfo
                          , stack :: Text
stack = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ CallStack -> String
Temporal.Exception.prettyCallStack CallStack
HasCallStack => CallStack
callStack
                          }
              Just (ActivityResult.ActivityResolution'Cancelled Cancellation
details) -> Result Payload -> InstanceM (Result Payload)
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result Payload -> InstanceM (Result Payload))
-> Result Payload -> InstanceM (Result Payload)
forall a b. (a -> b) -> a -> b
$ SomeException -> Result Payload
forall a. SomeException -> Result a
Throw (SomeException -> Result Payload)
-> SomeException -> Result Payload
forall a b. (a -> b) -> a -> b
$ ActivityCancelled -> SomeException
forall e. Exception e => e -> SomeException
toException (ActivityCancelled -> SomeException)
-> ActivityCancelled -> SomeException
forall a b. (a -> b) -> a -> b
$ Failure -> ActivityCancelled
ActivityCancelled (Cancellation
details Cancellation
-> FoldLike Failure Cancellation Cancellation Failure Failure
-> Failure
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Failure Cancellation Cancellation Failure Failure
forall (f :: * -> *) s a.
(Functor f, HasField s "failure" a) =>
LensLike' f s a
ActivityResult.failure)
              Just (ActivityResult.ActivityResolution'Backoff DoBackoff
_doBackoff) -> String -> InstanceM (Result Payload)
forall a. HasCallStack => String -> a
error String
"not implemented"
        , cancelAction = do
            let cancelCmd =
                  WorkflowCommand
forall msg. Message msg => msg
defMessage
                    WorkflowCommand
-> (WorkflowCommand -> WorkflowCommand) -> WorkflowCommand
forall s t. s -> (s -> t) -> t
& LensLike' f WorkflowCommand RequestCancelActivity
forall {f :: * -> *}.
Identical f =>
LensLike' f WorkflowCommand RequestCancelActivity
forall (f :: * -> *) s a.
(Functor f, HasField s "requestCancelActivity" a) =>
LensLike' f s a
Command.requestCancelActivity
                      (forall {f :: * -> *}.
 Identical f =>
 LensLike' f WorkflowCommand RequestCancelActivity)
-> RequestCancelActivity -> WorkflowCommand -> WorkflowCommand
forall s t a b. Setter s t a b -> b -> s -> t
.~ ( RequestCancelActivity
forall msg. Message msg => msg
defMessage
                            RequestCancelActivity
-> (RequestCancelActivity -> RequestCancelActivity)
-> RequestCancelActivity
forall s t. s -> (s -> t) -> t
& LensLike' f RequestCancelActivity Word32
forall {f :: * -> *}.
Identical f =>
LensLike' f RequestCancelActivity Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "seq" a) =>
LensLike' f s a
Command.seq (forall {f :: * -> *}.
 Identical f =>
 LensLike' f RequestCancelActivity Word32)
-> Word32 -> RequestCancelActivity -> RequestCancelActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ Word32
actSeq
                         )
            ilift $ addCommand cancelCmd
        }
  pure
    ( rawTask
        `bindTask` ( \Payload
payload -> (ContinuationEnv -> InstanceM (Result result)) -> Workflow result
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result result)) -> Workflow result)
-> (ContinuationEnv -> InstanceM (Result result))
-> Workflow result
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> do
                      result <- IO (Either String result) -> InstanceM (Either String result)
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String result) -> InstanceM (Either String result))
-> IO (Either String result) -> InstanceM (Either String result)
forall a b. (a -> b) -> a -> b
$ codec -> Payload -> IO (Either String result)
forall fmt a. Codec fmt a => fmt -> Payload -> IO (Either String a)
decode codec
codec Payload
payload
                      case result of
                        Left String
err -> Result result -> InstanceM (Result result)
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result result -> InstanceM (Result result))
-> Result result -> InstanceM (Result result)
forall a b. (a -> b) -> a -> b
$ SomeException -> Result result
forall a. SomeException -> Result a
Throw (SomeException -> Result result) -> SomeException -> Result result
forall a b. (a -> b) -> a -> b
$ ValueError -> SomeException
forall e. Exception e => e -> SomeException
toException (ValueError -> SomeException) -> ValueError -> SomeException
forall a b. (a -> b) -> a -> b
$ String -> ValueError
ValueError String
err
                        Right result
val -> Result result -> InstanceM (Result result)
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result result -> InstanceM (Result result))
-> Result result -> InstanceM (Result result)
forall a b. (a -> b) -> a -> b
$ result -> Result result
forall a. a -> Result a
Done result
val
                   )
    )


startActivity
  :: forall activity
   . (RequireCallStack, ActivityRef activity)
  => activity
  -> StartActivityOptions
  -> (ActivityArgs activity :->: Workflow (Task (ActivityResult activity)))
startActivity :: forall activity.
(RequireCallStack, ActivityRef activity) =>
activity
-> StartActivityOptions
-> ActivityArgs activity
   :->: Workflow (Task (ActivityResult activity))
startActivity (activity
-> KnownActivity (ActivityArgs activity) (ActivityResult activity)
forall f.
ActivityRef f =>
f -> KnownActivity (ActivityArgs f) (ActivityResult f)
activityRef -> k :: KnownActivity (ActivityArgs activity) (ActivityResult activity)
k@(KnownActivity codec
codec Text
_name)) StartActivityOptions
opts =
  forall (args :: [*]) result codec.
(VarArgs args, AllArgs (Codec codec) args) =>
codec
-> (Vector Payload -> Workflow result) -> args :->: Workflow result
withWorkflowArgs @(ActivityArgs activity) @(Task (ActivityResult activity)) codec
codec (KnownActivity (ActivityArgs activity) (ActivityResult activity)
-> StartActivityOptions
-> Vector Payload
-> Workflow (Task (ActivityResult activity))
forall (args :: [*]) result.
RequireCallStack =>
KnownActivity args result
-> StartActivityOptions -> Vector Payload -> Workflow (Task result)
startActivityFromPayloads KnownActivity (ActivityArgs activity) (ActivityResult activity)
k StartActivityOptions
opts)


executeActivity
  :: forall activity
   . (RequireCallStack, ActivityRef activity)
  => activity
  -> StartActivityOptions
  -> (ActivityArgs activity :->: Workflow (ActivityResult activity))
executeActivity :: forall activity.
(RequireCallStack, ActivityRef activity) =>
activity
-> StartActivityOptions
-> ActivityArgs activity :->: Workflow (ActivityResult activity)
executeActivity (activity
-> KnownActivity (ActivityArgs activity) (ActivityResult activity)
forall f.
ActivityRef f =>
f -> KnownActivity (ActivityArgs f) (ActivityResult f)
activityRef -> k :: KnownActivity (ActivityArgs activity) (ActivityResult activity)
k@(KnownActivity codec
codec Text
_name)) StartActivityOptions
opts = forall (args :: [*]) result codec.
(VarArgs args, AllArgs (Codec codec) args) =>
codec
-> (Vector Payload -> Workflow result) -> args :->: Workflow result
withWorkflowArgs @(ActivityArgs activity) @(ActivityResult activity) codec
codec ((Vector Payload -> Workflow (ActivityResult activity))
 -> ActivityArgs activity :->: Workflow (ActivityResult activity))
-> (Vector Payload -> Workflow (ActivityResult activity))
-> ActivityArgs activity :->: Workflow (ActivityResult activity)
forall a b. (a -> b) -> a -> b
$ \Vector Payload
typedPayloads -> do
  -- gatherArgs (Proxy @(ActivityArgs activity)) codec id $ \typedPayloads -> do
  actHandle <- KnownActivity (ActivityArgs activity) (ActivityResult activity)
-> StartActivityOptions
-> Vector Payload
-> Workflow (Task (ActivityResult activity))
forall (args :: [*]) result.
RequireCallStack =>
KnownActivity args result
-> StartActivityOptions -> Vector Payload -> Workflow (Task result)
startActivityFromPayloads KnownActivity (ActivityArgs activity) (ActivityResult activity)
k StartActivityOptions
opts Vector Payload
typedPayloads
  Temporal.Workflow.Unsafe.Handle.wait actHandle


{- | A client side handle to a single Workflow instance. It can be used to signal a workflow execution.

Given the following Workflow definition:
-}
class WorkflowHandle h where
  -- | Signal a running Workflow.
  signal :: (SignalRef ref, RequireCallStack) => h result -> ref -> (SignalArgs ref :->: Workflow (Task ()))


instance WorkflowHandle ChildWorkflowHandle where
  signal :: forall ref result.
(SignalRef ref, RequireCallStack) =>
ChildWorkflowHandle result
-> ref -> SignalArgs ref :->: Workflow (Task ())
signal ChildWorkflowHandle result
h =
    ChildWorkflowHandle result
-> (SignalExternalWorkflowExecution
    -> SignalExternalWorkflowExecution)
-> ref
-> SignalArgs ref :->: Workflow (Task ())
forall {k} (result :: k) (h :: k -> *) ref.
(RequireCallStack, SignalRef ref) =>
h result
-> (SignalExternalWorkflowExecution
    -> SignalExternalWorkflowExecution)
-> ref
-> SignalArgs ref :->: Workflow (Task ())
signalWorkflow ChildWorkflowHandle result
h (LensLike' f SignalExternalWorkflowExecution Text
forall {f :: * -> *}.
Identical f =>
LensLike' f SignalExternalWorkflowExecution Text
forall (f :: * -> *) s a.
(Functor f, HasField s "childWorkflowId" a) =>
LensLike' f s a
Command.childWorkflowId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f SignalExternalWorkflowExecution Text)
-> Text
-> SignalExternalWorkflowExecution
-> SignalExternalWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ WorkflowId -> Text
rawWorkflowId ChildWorkflowHandle result
h.childWorkflowId)


instance WorkflowHandle ExternalWorkflowHandle where
  signal :: forall ref result.
(SignalRef ref, RequireCallStack) =>
ExternalWorkflowHandle result
-> ref -> SignalArgs ref :->: Workflow (Task ())
signal ExternalWorkflowHandle result
h =
    ExternalWorkflowHandle result
-> (SignalExternalWorkflowExecution
    -> SignalExternalWorkflowExecution)
-> ref
-> SignalArgs ref :->: Workflow (Task ())
forall {k} (result :: k) (h :: k -> *) ref.
(RequireCallStack, SignalRef ref) =>
h result
-> (SignalExternalWorkflowExecution
    -> SignalExternalWorkflowExecution)
-> ref
-> SignalArgs ref :->: Workflow (Task ())
signalWorkflow ExternalWorkflowHandle result
h (LensLike'
  f SignalExternalWorkflowExecution NamespacedWorkflowExecution
forall {f :: * -> *}.
Identical f =>
LensLike'
  f SignalExternalWorkflowExecution NamespacedWorkflowExecution
forall (f :: * -> *) s a.
(Functor f, HasField s "workflowExecution" a) =>
LensLike' f s a
Command.workflowExecution (forall {f :: * -> *}.
 Identical f =>
 LensLike'
   f SignalExternalWorkflowExecution NamespacedWorkflowExecution)
-> NamespacedWorkflowExecution
-> SignalExternalWorkflowExecution
-> SignalExternalWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ NamespacedWorkflowExecution
converted)
    where
      converted :: NamespacedWorkflowExecution
converted =
        NamespacedWorkflowExecution
forall msg. Message msg => msg
defMessage
          NamespacedWorkflowExecution
-> (NamespacedWorkflowExecution -> NamespacedWorkflowExecution)
-> NamespacedWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f NamespacedWorkflowExecution Text
forall {f :: * -> *}.
Identical f =>
LensLike' f NamespacedWorkflowExecution Text
forall (f :: * -> *) s a.
(Functor f, HasField s "workflowId" a) =>
LensLike' f s a
Common.workflowId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f NamespacedWorkflowExecution Text)
-> Text
-> NamespacedWorkflowExecution
-> NamespacedWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ WorkflowId -> Text
rawWorkflowId ExternalWorkflowHandle result
h.externalWorkflowWorkflowId
          NamespacedWorkflowExecution
-> (NamespacedWorkflowExecution -> NamespacedWorkflowExecution)
-> NamespacedWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f NamespacedWorkflowExecution Text
forall {f :: * -> *}.
Identical f =>
LensLike' f NamespacedWorkflowExecution Text
forall (f :: * -> *) s a.
(Functor f, HasField s "runId" a) =>
LensLike' f s a
Common.runId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f NamespacedWorkflowExecution Text)
-> Text
-> NamespacedWorkflowExecution
-> NamespacedWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text -> (RunId -> Text) -> Maybe RunId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" RunId -> Text
rawRunId ExternalWorkflowHandle result
h.externalWorkflowRunId


-- TODO
-- & Common.namespace .~ rawNamespace h.externalNamespace

-- | A Workflow can send a Signal to another Workflow, in which case it's called an External Signal.
signalWorkflow
  :: forall result h ref
   . (RequireCallStack, SignalRef ref)
  => h result
  -> (Command.SignalExternalWorkflowExecution -> Command.SignalExternalWorkflowExecution)
  -> ref
  -> (SignalArgs ref :->: Workflow (Task ()))
signalWorkflow :: forall {k} (result :: k) (h :: k -> *) ref.
(RequireCallStack, SignalRef ref) =>
h result
-> (SignalExternalWorkflowExecution
    -> SignalExternalWorkflowExecution)
-> ref
-> SignalArgs ref :->: Workflow (Task ())
signalWorkflow h result
_ SignalExternalWorkflowExecution -> SignalExternalWorkflowExecution
f (ref -> KnownSignal (SignalArgs ref)
forall sig. SignalRef sig => sig -> KnownSignal (SignalArgs sig)
signalRef -> KnownSignal Text
signalName codec
signalCodec) = forall (args :: [*]) result codec.
(VarArgs args, AllArgs (Codec codec) args) =>
codec
-> (Vector Payload -> Workflow result) -> args :->: Workflow result
withWorkflowArgs @(SignalArgs ref) @(Task ()) codec
signalCodec ((Vector Payload -> Workflow (Task ()))
 -> SignalArgs ref :->: Workflow (Task ()))
-> (Vector Payload -> Workflow (Task ()))
-> SignalArgs ref :->: Workflow (Task ())
forall a b. (a -> b) -> a -> b
$ \Vector Payload
ps -> do
  InstanceM (Task ()) -> Workflow (Task ())
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM (Task ()) -> Workflow (Task ()))
-> InstanceM (Task ()) -> Workflow (Task ())
forall a b. (a -> b) -> a -> b
$ do
    InstanceM ()
RequireCallStack => InstanceM ()
updateCallStack
    resVar <- InstanceM (IVar ResolveSignalExternalWorkflow)
forall (m :: * -> *) a. MonadIO m => m (IVar a)
newIVar
    inst <- ask
    s <- nextExternalSignalSequence
    args <- processorEncodePayloads inst.payloadProcessor ps
    let cmd =
          WorkflowCommand
forall msg. Message msg => msg
defMessage
            WorkflowCommand
-> (WorkflowCommand -> WorkflowCommand) -> WorkflowCommand
forall s t. s -> (s -> t) -> t
& LensLike' f WorkflowCommand SignalExternalWorkflowExecution
forall {f :: * -> *}.
Identical f =>
LensLike' f WorkflowCommand SignalExternalWorkflowExecution
forall (f :: * -> *) s a.
(Functor f, HasField s "signalExternalWorkflowExecution" a) =>
LensLike' f s a
Command.signalExternalWorkflowExecution
              (forall {f :: * -> *}.
 Identical f =>
 LensLike' f WorkflowCommand SignalExternalWorkflowExecution)
-> SignalExternalWorkflowExecution
-> WorkflowCommand
-> WorkflowCommand
forall s t a b. Setter s t a b -> b -> s -> t
.~ SignalExternalWorkflowExecution -> SignalExternalWorkflowExecution
f
                ( SignalExternalWorkflowExecution
forall msg. Message msg => msg
defMessage
                    SignalExternalWorkflowExecution
-> (SignalExternalWorkflowExecution
    -> SignalExternalWorkflowExecution)
-> SignalExternalWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f SignalExternalWorkflowExecution Word32
forall {f :: * -> *}.
Identical f =>
LensLike' f SignalExternalWorkflowExecution Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "seq" a) =>
LensLike' f s a
Command.seq (forall {f :: * -> *}.
 Identical f =>
 LensLike' f SignalExternalWorkflowExecution Word32)
-> Word32
-> SignalExternalWorkflowExecution
-> SignalExternalWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ Sequence -> Word32
rawSequence Sequence
s
                    SignalExternalWorkflowExecution
-> (SignalExternalWorkflowExecution
    -> SignalExternalWorkflowExecution)
-> SignalExternalWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f SignalExternalWorkflowExecution Text
forall {f :: * -> *}.
Identical f =>
LensLike' f SignalExternalWorkflowExecution Text
forall (f :: * -> *) s a.
(Functor f, HasField s "signalName" a) =>
LensLike' f s a
Command.signalName (forall {f :: * -> *}.
 Identical f =>
 LensLike' f SignalExternalWorkflowExecution Text)
-> Text
-> SignalExternalWorkflowExecution
-> SignalExternalWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
signalName
                    SignalExternalWorkflowExecution
-> (SignalExternalWorkflowExecution
    -> SignalExternalWorkflowExecution)
-> SignalExternalWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f SignalExternalWorkflowExecution (Vector Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f SignalExternalWorkflowExecution (Vector Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "vec'args" a) =>
LensLike' f s a
Command.vec'args (forall {f :: * -> *}.
 Identical f =>
 LensLike' f SignalExternalWorkflowExecution (Vector Payload))
-> Vector Payload
-> SignalExternalWorkflowExecution
-> SignalExternalWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Payload -> Payload) -> Vector Payload -> Vector Payload
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertToProtoPayload Vector Payload
args
                    -- TODO
                    -- & Command.headers .~ _
                )
    addCommand cmd
    atomically $ modifyTVar' inst.workflowSequenceMaps $ \SequenceMaps
seqMaps ->
      SequenceMaps
seqMaps {externalSignals = HashMap.insert s resVar seqMaps.externalSignals}
    pure $
      Task
        { waitAction = do
            res <- getIVar resVar
            case res ^. Activation.maybe'failure of
              Maybe Failure
Nothing -> () -> Workflow ()
forall a. a -> Workflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              Just Failure
failureInfo -> SignalExternalWorkflowFailed -> Workflow ()
forall e a. (HasCallStack, Exception e) => e -> Workflow a
throw (SignalExternalWorkflowFailed -> Workflow ())
-> SignalExternalWorkflowFailed -> Workflow ()
forall a b. (a -> b) -> a -> b
$ Failure -> SignalExternalWorkflowFailed
SignalExternalWorkflowFailed Failure
failureInfo
        , cancelAction = do
            let cancelCmd =
                  WorkflowCommand
forall msg. Message msg => msg
defMessage
                    WorkflowCommand
-> (WorkflowCommand -> WorkflowCommand) -> WorkflowCommand
forall s t. s -> (s -> t) -> t
& LensLike' f WorkflowCommand CancelSignalWorkflow
forall {f :: * -> *}.
Identical f =>
LensLike' f WorkflowCommand CancelSignalWorkflow
forall (f :: * -> *) s a.
(Functor f, HasField s "cancelSignalWorkflow" a) =>
LensLike' f s a
Command.cancelSignalWorkflow
                      (forall {f :: * -> *}.
 Identical f =>
 LensLike' f WorkflowCommand CancelSignalWorkflow)
-> CancelSignalWorkflow -> WorkflowCommand -> WorkflowCommand
forall s t a b. Setter s t a b -> b -> s -> t
.~ ( CancelSignalWorkflow
forall msg. Message msg => msg
defMessage
                            CancelSignalWorkflow
-> (CancelSignalWorkflow -> CancelSignalWorkflow)
-> CancelSignalWorkflow
forall s t. s -> (s -> t) -> t
& LensLike' f CancelSignalWorkflow Word32
forall {f :: * -> *}.
Identical f =>
LensLike' f CancelSignalWorkflow Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "seq" a) =>
LensLike' f s a
Command.seq (forall {f :: * -> *}.
 Identical f =>
 LensLike' f CancelSignalWorkflow Word32)
-> Word32 -> CancelSignalWorkflow -> CancelSignalWorkflow
forall s t a b. Setter s t a b -> b -> s -> t
.~ Sequence -> Word32
rawSequence Sequence
s
                         )
            ilift $ addCommand cancelCmd
        }


startChildWorkflowFromPayloads
  :: forall wf
   . (RequireCallStack, WorkflowRef wf)
  => wf
  -> StartChildWorkflowOptions
  -> Vector Payload
  -> Workflow (ChildWorkflowHandle (WorkflowResult wf))
startChildWorkflowFromPayloads :: forall wf.
(RequireCallStack, WorkflowRef wf) =>
wf
-> StartChildWorkflowOptions
-> Vector Payload
-> Workflow (ChildWorkflowHandle (WorkflowResult wf))
startChildWorkflowFromPayloads (wf -> KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf)
forall f.
WorkflowRef f =>
f -> KnownWorkflow (WorkflowArgs f) (WorkflowResult f)
workflowRef -> k :: KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf)
k@(KnownWorkflow codec
codec Text
_)) StartChildWorkflowOptions
opts Vector Payload
ps = do
  wfId <- case StartChildWorkflowOptions
opts.workflowId of
    Maybe WorkflowId
Nothing -> Text -> WorkflowId
WorkflowId (Text -> WorkflowId) -> (UUID -> Text) -> UUID -> WorkflowId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
UUID.toText (UUID -> WorkflowId) -> Workflow UUID -> Workflow WorkflowId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workflow UUID
uuid4
    Just WorkflowId
wfId -> WorkflowId -> Workflow WorkflowId
forall a. a -> Workflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WorkflowId
wfId
  ilift $ go ps wfId
  where
    go :: Vector Payload -> WorkflowId -> InstanceM (ChildWorkflowHandle (WorkflowResult wf))
    go :: Vector Payload
-> WorkflowId
-> InstanceM (ChildWorkflowHandle (WorkflowResult wf))
go Vector Payload
typedPayloads WorkflowId
wfId = do
      InstanceM ()
RequireCallStack => InstanceM ()
updateCallStack
      Vector Payload
-> WorkflowId
-> InstanceM (ChildWorkflowHandle (WorkflowResult wf))
sendChildWorkflowCommand Vector Payload
typedPayloads WorkflowId
wfId
    sendChildWorkflowCommand :: Vector Payload
-> WorkflowId
-> InstanceM (ChildWorkflowHandle (WorkflowResult wf))
sendChildWorkflowCommand Vector Payload
typedPayloads WorkflowId
wfId = do
      inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
      -- TODO these need to pass through the interceptor
      runInIO <- askRunInIO
      wfHandle <- liftIO $ inst.outboundInterceptor.startChildWorkflowExecution (knownWorkflowName k) opts $ \Text
wfName StartChildWorkflowOptions
opts' -> InstanceM (ChildWorkflowHandle Payload)
-> IO (ChildWorkflowHandle Payload)
runInIO (InstanceM (ChildWorkflowHandle Payload)
 -> IO (ChildWorkflowHandle Payload))
-> InstanceM (ChildWorkflowHandle Payload)
-> IO (ChildWorkflowHandle Payload)
forall a b. (a -> b) -> a -> b
$ do
        args <- PayloadProcessor -> Vector Payload -> InstanceM (Vector Payload)
forall (m :: * -> *) (f :: * -> *).
(MonadIO m, Traversable f) =>
PayloadProcessor -> f Payload -> m (f Payload)
processorEncodePayloads WorkflowInstance
inst.payloadProcessor Vector Payload
typedPayloads
        let convertedPayloads = (Payload -> Payload) -> Vector Payload -> Vector Payload
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertToProtoPayload Vector Payload
args
        hdrs <- processorEncodePayloads inst.payloadProcessor opts'.headers
        memo <- processorEncodePayloads inst.payloadProcessor opts'.initialMemo

        s@(Sequence wfSeq) <- nextChildWorkflowSequence
        startSlot <- newIVar
        resultSlot <- newIVar
        firstExecutionRunId <- newIVar
        i <- readIORef inst.workflowInstanceInfo
        searchAttrs <- liftIO $ searchAttributesToProto opts'.searchAttributes
        let childWorkflowOptions =
              StartChildWorkflowExecution
forall msg. Message msg => msg
defMessage
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution Word32
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "seq" a) =>
LensLike' f s a
Command.seq (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution Word32)
-> Word32
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ Word32
wfSeq
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution Text
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution Text
forall (f :: * -> *) s a.
(Functor f, HasField s "namespace" a) =>
LensLike' f s a
Command.namespace (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution Text)
-> Text
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ Namespace -> Text
rawNamespace Info
i.namespace
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution Text
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution Text
forall (f :: * -> *) s a.
(Functor f, HasField s "workflowId" a) =>
LensLike' f s a
Command.workflowId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution Text)
-> Text
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ WorkflowId -> Text
rawWorkflowId WorkflowId
wfId
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution Text
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution Text
forall (f :: * -> *) s a.
(Functor f, HasField s "workflowType" a) =>
LensLike' f s a
Command.workflowType (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution Text)
-> Text
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
wfName
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution Text
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution Text
forall (f :: * -> *) s a.
(Functor f, HasField s "taskQueue" a) =>
LensLike' f s a
Command.taskQueue (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution Text)
-> Text
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ TaskQueue -> Text
rawTaskQueue (TaskQueue -> Maybe TaskQueue -> TaskQueue
forall a. a -> Maybe a -> a
fromMaybe Info
i.taskQueue StartChildWorkflowOptions
opts'.taskQueue)
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution (Vector Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution (Vector Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "vec'input" a) =>
LensLike' f s a
Command.vec'input (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution (Vector Payload))
-> Vector Payload
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ Vector Payload
convertedPayloads
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'workflowExecutionTimeout" a) =>
LensLike' f s a
Command.maybe'workflowExecutionTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution (Maybe Duration))
-> Maybe Duration
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationToProto StartChildWorkflowOptions
opts'.timeoutOptions.executionTimeout
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'workflowRunTimeout" a) =>
LensLike' f s a
Command.maybe'workflowRunTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution (Maybe Duration))
-> Maybe Duration
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationToProto StartChildWorkflowOptions
opts'.timeoutOptions.runTimeout
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'workflowTaskTimeout" a) =>
LensLike' f s a
Command.maybe'workflowTaskTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution (Maybe Duration))
-> Maybe Duration
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationToProto StartChildWorkflowOptions
opts'.timeoutOptions.taskTimeout
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution ParentClosePolicy
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution ParentClosePolicy
forall (f :: * -> *) s a.
(Functor f, HasField s "parentClosePolicy" a) =>
LensLike' f s a
Command.parentClosePolicy (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution ParentClosePolicy)
-> ParentClosePolicy
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ ParentClosePolicy -> ParentClosePolicy
parentClosePolicyToProto StartChildWorkflowOptions
opts'.parentClosePolicy
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution WorkflowIdReusePolicy
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution WorkflowIdReusePolicy
forall (f :: * -> *) s a.
(Functor f, HasField s "workflowIdReusePolicy" a) =>
LensLike' f s a
Command.workflowIdReusePolicy (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution WorkflowIdReusePolicy)
-> WorkflowIdReusePolicy
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ WorkflowIdReusePolicy -> WorkflowIdReusePolicy
workflowIdReusePolicyToProto StartChildWorkflowOptions
opts'.workflowIdReusePolicy
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution (Maybe RetryPolicy)
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution (Maybe RetryPolicy)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'retryPolicy" a) =>
LensLike' f s a
Command.maybe'retryPolicy (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution (Maybe RetryPolicy))
-> Maybe RetryPolicy
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ (RetryPolicy -> RetryPolicy)
-> Maybe RetryPolicy -> Maybe RetryPolicy
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RetryPolicy -> RetryPolicy
retryPolicyToProto StartChildWorkflowOptions
opts'.retryPolicy
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution Text
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution Text
forall (f :: * -> *) s a.
(Functor f, HasField s "cronSchedule" a) =>
LensLike' f s a
Command.cronSchedule (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution Text)
-> Text
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" StartChildWorkflowOptions
opts'.cronSchedule
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution (Map Text Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution (Map Text Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "headers" a) =>
LensLike' f s a
Command.headers (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution (Map Text Payload))
-> Map Text Payload
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Payload -> Payload) -> Map Text Payload -> Map Text Payload
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertToProtoPayload Map Text Payload
hdrs
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution (Map Text Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution (Map Text Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "memo" a) =>
LensLike' f s a
Command.memo (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution (Map Text Payload))
-> Map Text Payload
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Payload -> Payload) -> Map Text Payload -> Map Text Payload
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertToProtoPayload Map Text Payload
memo
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f StartChildWorkflowExecution (Map Text Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f StartChildWorkflowExecution (Map Text Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "searchAttributes" a) =>
LensLike' f s a
Command.searchAttributes (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartChildWorkflowExecution (Map Text Payload))
-> Map Text Payload
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ Map Text Payload
searchAttrs
                StartChildWorkflowExecution
-> (StartChildWorkflowExecution -> StartChildWorkflowExecution)
-> StartChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike'
  f StartChildWorkflowExecution ChildWorkflowCancellationType
forall {f :: * -> *}.
Identical f =>
LensLike'
  f StartChildWorkflowExecution ChildWorkflowCancellationType
forall (f :: * -> *) s a.
(Functor f, HasField s "cancellationType" a) =>
LensLike' f s a
Command.cancellationType (forall {f :: * -> *}.
 Identical f =>
 LensLike'
   f StartChildWorkflowExecution ChildWorkflowCancellationType)
-> ChildWorkflowCancellationType
-> StartChildWorkflowExecution
-> StartChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ ChildWorkflowCancellationType -> ChildWorkflowCancellationType
childWorkflowCancellationTypeToProto StartChildWorkflowOptions
opts'.cancellationType

            cmd =
              WorkflowCommand
forall msg. Message msg => msg
defMessage
                WorkflowCommand
-> (WorkflowCommand -> WorkflowCommand) -> WorkflowCommand
forall s t. s -> (s -> t) -> t
& LensLike' f WorkflowCommand StartChildWorkflowExecution
forall {f :: * -> *}.
Identical f =>
LensLike' f WorkflowCommand StartChildWorkflowExecution
forall (f :: * -> *) s a.
(Functor f, HasField s "startChildWorkflowExecution" a) =>
LensLike' f s a
Command.startChildWorkflowExecution (forall {f :: * -> *}.
 Identical f =>
 LensLike' f WorkflowCommand StartChildWorkflowExecution)
-> StartChildWorkflowExecution
-> WorkflowCommand
-> WorkflowCommand
forall s t a b. Setter s t a b -> b -> s -> t
.~ StartChildWorkflowExecution
childWorkflowOptions

            wfHandle =
              ChildWorkflowHandle
                { childWorkflowSequence :: Sequence
childWorkflowSequence = Sequence
s
                , startHandle :: IVar ()
startHandle = IVar ()
startSlot
                , resultHandle :: IVar ResolveChildWorkflowExecution
resultHandle = IVar ResolveChildWorkflowExecution
resultSlot
                , firstExecutionRunId :: IVar RunId
firstExecutionRunId = IVar RunId
firstExecutionRunId
                , childWorkflowResultConverter :: Payload -> UnencodedPayload
childWorkflowResultConverter = Payload -> UnencodedPayload
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                , childWorkflowId :: WorkflowId
childWorkflowId = WorkflowId
wfId
                }

        atomically $ modifyTVar' inst.workflowSequenceMaps $ \SequenceMaps
seqMaps ->
          SequenceMaps
seqMaps {childWorkflows = HashMap.insert s (SomeChildWorkflowHandle wfHandle) seqMaps.childWorkflows}

        addCommand cmd
        pure wfHandle
      pure $
        wfHandle
          { childWorkflowResultConverter = \Payload
r -> do
              decodingResult <- codec -> Payload -> IO (Either String (WorkflowResult wf))
forall fmt a. Codec fmt a => fmt -> Payload -> IO (Either String a)
decode codec
codec (Payload -> IO (Either String (WorkflowResult wf)))
-> UnencodedPayload -> IO (Either String (WorkflowResult wf))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> UnencodedPayload)
-> (Payload -> UnencodedPayload)
-> Either String Payload
-> UnencodedPayload
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ValueError -> UnencodedPayload
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ValueError -> UnencodedPayload)
-> (String -> ValueError) -> String -> UnencodedPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ValueError
ValueError) Payload -> UnencodedPayload
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Payload -> UnencodedPayload)
-> IO (Either String Payload) -> UnencodedPayload
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PayloadProcessor -> Payload -> IO (Either String Payload)
payloadProcessorDecode WorkflowInstance
inst.payloadProcessor Payload
r
              case decodingResult of
                Left String
err -> ValueError -> IO (WorkflowResult wf)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ValueError -> IO (WorkflowResult wf))
-> ValueError -> IO (WorkflowResult wf)
forall a b. (a -> b) -> a -> b
$ String -> ValueError
ValueError String
err
                Right WorkflowResult wf
val -> WorkflowResult wf -> IO (WorkflowResult wf)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WorkflowResult wf
val
          }


{- $childWorkflow

A Child Workflow Execution is a Workflow Execution that is spawned from within another Workflow.

A Workflow Execution can be both a Parent and a Child Workflow Execution because any Workflow can spawn another Workflow.
-}


{- | Start a child Workflow execution

Returns a client-side handle that implements a child Workflow interface.

By default, a child will be scheduled on the same task queue as its parent.

A child Workflow handle supports awaiting completion, signaling and cancellation via the returned handle.

In order to query the child, use a WorkflowClient from an Activity.
-}
startChildWorkflow
  :: forall wf
   . (RequireCallStack, WorkflowRef wf)
  => wf
  -> StartChildWorkflowOptions
  -> (WorkflowArgs wf :->: Workflow (ChildWorkflowHandle (WorkflowResult wf)))
startChildWorkflow :: forall wf.
(RequireCallStack, WorkflowRef wf) =>
wf
-> StartChildWorkflowOptions
-> WorkflowArgs wf
   :->: Workflow (ChildWorkflowHandle (WorkflowResult wf))
startChildWorkflow (wf -> KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf)
forall f.
WorkflowRef f =>
f -> KnownWorkflow (WorkflowArgs f) (WorkflowResult f)
workflowRef -> k :: KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf)
k@(KnownWorkflow codec
codec Text
_)) StartChildWorkflowOptions
opts =
  forall (args :: [*]) result codec.
(VarArgs args, AllArgs (Codec codec) args) =>
codec
-> (Vector Payload -> Workflow result) -> args :->: Workflow result
withWorkflowArgs @(WorkflowArgs wf) @(ChildWorkflowHandle (WorkflowResult wf)) codec
codec (KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf)
-> StartChildWorkflowOptions
-> Vector Payload
-> Workflow
     (ChildWorkflowHandle
        (WorkflowResult
           (KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf))))
forall wf.
(RequireCallStack, WorkflowRef wf) =>
wf
-> StartChildWorkflowOptions
-> Vector Payload
-> Workflow (ChildWorkflowHandle (WorkflowResult wf))
startChildWorkflowFromPayloads KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf)
k StartChildWorkflowOptions
opts)


executeChildWorkflow
  :: forall wf
   . (RequireCallStack, WorkflowRef wf)
  => wf
  -> StartChildWorkflowOptions
  -> (WorkflowArgs wf :->: Workflow (WorkflowResult wf))
executeChildWorkflow :: forall wf.
(RequireCallStack, WorkflowRef wf) =>
wf
-> StartChildWorkflowOptions
-> WorkflowArgs wf :->: Workflow (WorkflowResult wf)
executeChildWorkflow (wf -> KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf)
forall f.
WorkflowRef f =>
f -> KnownWorkflow (WorkflowArgs f) (WorkflowResult f)
workflowRef -> k :: KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf)
k@(KnownWorkflow codec
codec Text
_)) StartChildWorkflowOptions
opts = forall (args :: [*]) result codec.
(VarArgs args, AllArgs (Codec codec) args) =>
codec
-> (Vector Payload -> Workflow result) -> args :->: Workflow result
withWorkflowArgs @(WorkflowArgs wf) @(WorkflowResult wf) codec
codec ((Vector Payload -> Workflow (WorkflowResult wf))
 -> WorkflowArgs wf :->: Workflow (WorkflowResult wf))
-> (Vector Payload -> Workflow (WorkflowResult wf))
-> WorkflowArgs wf :->: Workflow (WorkflowResult wf)
forall a b. (a -> b) -> a -> b
$ \Vector Payload
typedPayloads -> do
  h <- KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf)
-> StartChildWorkflowOptions
-> Vector Payload
-> Workflow
     (ChildWorkflowHandle
        (WorkflowResult
           (KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf))))
forall wf.
(RequireCallStack, WorkflowRef wf) =>
wf
-> StartChildWorkflowOptions
-> Vector Payload
-> Workflow (ChildWorkflowHandle (WorkflowResult wf))
startChildWorkflowFromPayloads KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf)
k StartChildWorkflowOptions
opts Vector Payload
typedPayloads
  waitChildWorkflowResult h


data StartLocalActivityOptions = StartLocalActivityOptions
  { StartLocalActivityOptions -> Maybe ActivityId
activityId :: Maybe ActivityId
  , StartLocalActivityOptions -> Maybe Duration
scheduleToCloseTimeout :: Maybe Duration
  -- ^ Indicates how long the caller is willing to wait for local activity completion. Limits how
  -- long retries will be attempted. When not specified defaults to the workflow execution
  -- timeout (which may be unset).
  , StartLocalActivityOptions -> Maybe Duration
scheduleToStartTimeout :: Maybe Duration
  -- ^ Limits time the local activity can idle internally before being executed. That can happen if
  -- the worker is currently at max concurrent local activity executions. This timeout is always
  -- non retryable as all a retry would achieve is to put it back into the same queue. Defaults
  -- to `schedule_to_close_timeout` if not specified and that is set. Must be <=
  -- `schedule_to_close_timeout` when set, otherwise, it will be clamped down.
  , StartLocalActivityOptions -> Maybe Duration
startToCloseTimeout :: Maybe Duration
  -- ^ Maximum time the local activity is allowed to execute after the task is dispatched. This
  -- timeout is always retryable. Either or both of `schedule_to_close_timeout` and this must be
  -- specified. If set, this must be <= `schedule_to_close_timeout`, otherwise, it will be
  -- clamped down.
  , StartLocalActivityOptions -> Maybe RetryPolicy
retryPolicy :: Maybe RetryPolicy
  -- ^ Specify a retry policy for the local activity. By default local activities will be retried
  -- indefinitely.
  , StartLocalActivityOptions -> Maybe Duration
localRetryThreshold :: Maybe Duration
  -- ^ If the activity is retrying and backoff would exceed this value, lang will be told to
  -- schedule a timer and retry the activity after. Otherwise, backoff will happen internally in
  -- core. Defaults to 1 minute.
  , StartLocalActivityOptions -> ActivityCancellationType
cancellationType :: ActivityCancellationType
  -- ^ Defines how the workflow will wait (or not) for cancellation of the activity to be
  -- confirmed. Lang should default this to `WAIT_CANCELLATION_COMPLETED`, even though proto
  -- will default to `TRY_CANCEL` automatically.
  , StartLocalActivityOptions -> Map Text Payload
headers :: Map Text Payload
  }


defaultStartLocalActivityOptions :: StartLocalActivityOptions
defaultStartLocalActivityOptions :: StartLocalActivityOptions
defaultStartLocalActivityOptions =
  StartLocalActivityOptions
    { activityId :: Maybe ActivityId
activityId = Maybe ActivityId
forall a. Maybe a
Nothing
    , scheduleToCloseTimeout :: Maybe Duration
scheduleToCloseTimeout = Maybe Duration
forall a. Maybe a
Nothing
    , scheduleToStartTimeout :: Maybe Duration
scheduleToStartTimeout = Maybe Duration
forall a. Maybe a
Nothing
    , startToCloseTimeout :: Maybe Duration
startToCloseTimeout = Maybe Duration
forall a. Maybe a
Nothing
    , retryPolicy :: Maybe RetryPolicy
retryPolicy = Maybe RetryPolicy
forall a. Maybe a
Nothing
    , localRetryThreshold :: Maybe Duration
localRetryThreshold = Maybe Duration
forall a. Maybe a
Nothing
    , cancellationType :: ActivityCancellationType
cancellationType = ActivityCancellationType
ActivityCancellationWaitCancellationCompleted
    , headers :: Map Text Payload
headers = Map Text Payload
forall a. Monoid a => a
mempty
    }


startLocalActivity
  :: forall act
   . (RequireCallStack, ActivityRef act)
  => act
  -> StartLocalActivityOptions
  -> (ActivityArgs act :->: Workflow (Task (ActivityResult act)))
startLocalActivity :: forall act.
(RequireCallStack, ActivityRef act) =>
act
-> StartLocalActivityOptions
-> ActivityArgs act :->: Workflow (Task (ActivityResult act))
startLocalActivity (act -> KnownActivity (ActivityArgs act) (ActivityResult act)
forall f.
ActivityRef f =>
f -> KnownActivity (ActivityArgs f) (ActivityResult f)
activityRef -> KnownActivity codec
codec Text
n) StartLocalActivityOptions
opts = forall (args :: [*]) result codec.
(VarArgs args, AllArgs (Codec codec) args) =>
codec
-> (Vector Payload -> Workflow result) -> args :->: Workflow result
withWorkflowArgs @(ActivityArgs act) @(Task (ActivityResult act)) codec
codec ((Vector Payload -> Workflow (Task (ActivityResult act)))
 -> ActivityArgs act :->: Workflow (Task (ActivityResult act)))
-> (Vector Payload -> Workflow (Task (ActivityResult act)))
-> ActivityArgs act :->: Workflow (Task (ActivityResult act))
forall a b. (a -> b) -> a -> b
$ \Vector Payload
typedPayloads -> do
  Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
  originalTime <- Workflow SystemTime
RequireCallStack => Workflow SystemTime
time
  ilift $ do
    inst <- ask
    let ps = (Payload -> Payload) -> Vector Payload -> Vector Payload
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertToProtoPayload Vector Payload
typedPayloads
    s@(Sequence actSeq) <- nextActivitySequence
    resultSlot <- newIVar
    atomically $ modifyTVar' inst.workflowSequenceMaps $ \SequenceMaps
seqMaps ->
      SequenceMaps
seqMaps {activities = HashMap.insert s resultSlot (activities seqMaps)}
    -- TODO, seems like `attempt` and `originalScheduledTime`
    -- imply that we are in charge of retrying local activities ourselves?
    let actId = Text -> (ActivityId -> Text) -> Maybe ActivityId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Word32 -> String
forall a. Show a => a -> String
show Word32
actSeq) ActivityId -> Text
rawActivityId StartLocalActivityOptions
opts.activityId
        cmd =
          WorkflowCommand
forall msg. Message msg => msg
defMessage
            WorkflowCommand
-> (WorkflowCommand -> WorkflowCommand) -> WorkflowCommand
forall s t. s -> (s -> t) -> t
& LensLike' f WorkflowCommand ScheduleLocalActivity
forall {f :: * -> *}.
Identical f =>
LensLike' f WorkflowCommand ScheduleLocalActivity
forall (f :: * -> *) s a.
(Functor f, HasField s "scheduleLocalActivity" a) =>
LensLike' f s a
Command.scheduleLocalActivity
              (forall {f :: * -> *}.
 Identical f =>
 LensLike' f WorkflowCommand ScheduleLocalActivity)
-> ScheduleLocalActivity -> WorkflowCommand -> WorkflowCommand
forall s t a b. Setter s t a b -> b -> s -> t
.~ ( ScheduleLocalActivity
forall msg. Message msg => msg
defMessage
                    ScheduleLocalActivity
-> (ScheduleLocalActivity -> ScheduleLocalActivity)
-> ScheduleLocalActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleLocalActivity Word32
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleLocalActivity Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "seq" a) =>
LensLike' f s a
Command.seq (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleLocalActivity Word32)
-> Word32 -> ScheduleLocalActivity -> ScheduleLocalActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ Word32
actSeq
                    ScheduleLocalActivity
-> (ScheduleLocalActivity -> ScheduleLocalActivity)
-> ScheduleLocalActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleLocalActivity Text
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleLocalActivity Text
forall (f :: * -> *) s a.
(Functor f, HasField s "activityId" a) =>
LensLike' f s a
Command.activityId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleLocalActivity Text)
-> Text -> ScheduleLocalActivity -> ScheduleLocalActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
actId
                    ScheduleLocalActivity
-> (ScheduleLocalActivity -> ScheduleLocalActivity)
-> ScheduleLocalActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleLocalActivity Text
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleLocalActivity Text
forall (f :: * -> *) s a.
(Functor f, HasField s "activityType" a) =>
LensLike' f s a
Command.activityType (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleLocalActivity Text)
-> Text -> ScheduleLocalActivity -> ScheduleLocalActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
n
                    -- & attempt .~ _
                    -- & headers .~ _
                    ScheduleLocalActivity
-> (ScheduleLocalActivity -> ScheduleLocalActivity)
-> ScheduleLocalActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleLocalActivity Timestamp
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleLocalActivity Timestamp
forall (f :: * -> *) s a.
(Functor f, HasField s "originalScheduleTime" a) =>
LensLike' f s a
Command.originalScheduleTime (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleLocalActivity Timestamp)
-> Timestamp -> ScheduleLocalActivity -> ScheduleLocalActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ SystemTime -> Timestamp
timespecToTimestamp SystemTime
originalTime
                    ScheduleLocalActivity
-> (ScheduleLocalActivity -> ScheduleLocalActivity)
-> ScheduleLocalActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleLocalActivity (Vector Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleLocalActivity (Vector Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "vec'arguments" a) =>
LensLike' f s a
Command.vec'arguments (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleLocalActivity (Vector Payload))
-> Vector Payload -> ScheduleLocalActivity -> ScheduleLocalActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ Vector Payload
ps
                    ScheduleLocalActivity
-> (ScheduleLocalActivity -> ScheduleLocalActivity)
-> ScheduleLocalActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleLocalActivity (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleLocalActivity (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'scheduleToCloseTimeout" a) =>
LensLike' f s a
Command.maybe'scheduleToCloseTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleLocalActivity (Maybe Duration))
-> Maybe Duration -> ScheduleLocalActivity -> ScheduleLocalActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration
durationToProto (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StartLocalActivityOptions
opts.scheduleToCloseTimeout)
                    ScheduleLocalActivity
-> (ScheduleLocalActivity -> ScheduleLocalActivity)
-> ScheduleLocalActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleLocalActivity (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleLocalActivity (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'scheduleToStartTimeout" a) =>
LensLike' f s a
Command.maybe'scheduleToStartTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleLocalActivity (Maybe Duration))
-> Maybe Duration -> ScheduleLocalActivity -> ScheduleLocalActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration
durationToProto (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StartLocalActivityOptions
opts.scheduleToStartTimeout)
                    ScheduleLocalActivity
-> (ScheduleLocalActivity -> ScheduleLocalActivity)
-> ScheduleLocalActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleLocalActivity (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleLocalActivity (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'startToCloseTimeout" a) =>
LensLike' f s a
Command.maybe'startToCloseTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleLocalActivity (Maybe Duration))
-> Maybe Duration -> ScheduleLocalActivity -> ScheduleLocalActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration
durationToProto (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StartLocalActivityOptions
opts.startToCloseTimeout)
                    ScheduleLocalActivity
-> (ScheduleLocalActivity -> ScheduleLocalActivity)
-> ScheduleLocalActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleLocalActivity (Maybe RetryPolicy)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleLocalActivity (Maybe RetryPolicy)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'retryPolicy" a) =>
LensLike' f s a
Command.maybe'retryPolicy (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleLocalActivity (Maybe RetryPolicy))
-> Maybe RetryPolicy
-> ScheduleLocalActivity
-> ScheduleLocalActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ (RetryPolicy -> RetryPolicy
retryPolicyToProto (RetryPolicy -> RetryPolicy)
-> Maybe RetryPolicy -> Maybe RetryPolicy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StartLocalActivityOptions
opts.retryPolicy)
                    ScheduleLocalActivity
-> (ScheduleLocalActivity -> ScheduleLocalActivity)
-> ScheduleLocalActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleLocalActivity (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleLocalActivity (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'localRetryThreshold" a) =>
LensLike' f s a
Command.maybe'localRetryThreshold (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleLocalActivity (Maybe Duration))
-> Maybe Duration -> ScheduleLocalActivity -> ScheduleLocalActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration
durationToProto (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StartLocalActivityOptions
opts.localRetryThreshold)
                    ScheduleLocalActivity
-> (ScheduleLocalActivity -> ScheduleLocalActivity)
-> ScheduleLocalActivity
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleLocalActivity ActivityCancellationType
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleLocalActivity ActivityCancellationType
forall (f :: * -> *) s a.
(Functor f, HasField s "cancellationType" a) =>
LensLike' f s a
Command.cancellationType (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleLocalActivity ActivityCancellationType)
-> ActivityCancellationType
-> ScheduleLocalActivity
-> ScheduleLocalActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ ActivityCancellationType -> ActivityCancellationType
activityCancellationTypeToProto StartLocalActivityOptions
opts.cancellationType
                 )
    addCommand cmd
    pure $
      Task
        { waitAction = do
            res <- getIVar resultSlot
            Workflow $ \ContinuationEnv
_ -> case ResolveActivity
res ResolveActivity
-> FoldLike
     (Maybe ActivityResolution'Status)
     ResolveActivity
     ResolveActivity
     (Maybe ActivityResolution'Status)
     (Maybe ActivityResolution'Status)
-> Maybe ActivityResolution'Status
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike'
  (Constant (Maybe ActivityResolution'Status))
  ResolveActivity
  ActivityResolution
forall (f :: * -> *) s a.
(Functor f, HasField s "result" a) =>
LensLike' f s a
Activation.result LensLike'
  (Constant (Maybe ActivityResolution'Status))
  ResolveActivity
  ActivityResolution
-> ((Maybe ActivityResolution'Status
     -> Constant
          (Maybe ActivityResolution'Status)
          (Maybe ActivityResolution'Status))
    -> ActivityResolution
    -> Constant (Maybe ActivityResolution'Status) ActivityResolution)
-> FoldLike
     (Maybe ActivityResolution'Status)
     ResolveActivity
     ResolveActivity
     (Maybe ActivityResolution'Status)
     (Maybe ActivityResolution'Status)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ActivityResolution'Status
 -> Constant
      (Maybe ActivityResolution'Status)
      (Maybe ActivityResolution'Status))
-> ActivityResolution
-> Constant (Maybe ActivityResolution'Status) ActivityResolution
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'status" a) =>
LensLike' f s a
ActivityResult.maybe'status of
              Maybe ActivityResolution'Status
Nothing -> String -> InstanceM (Result (ActivityResult act))
forall a. HasCallStack => String -> a
error String
"Activity result missing status"
              Just (ActivityResult.ActivityResolution'Completed Success
success) -> do
                result <- IO (Either String (ActivityResult act))
-> InstanceM (Either String (ActivityResult act))
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String (ActivityResult act))
 -> InstanceM (Either String (ActivityResult act)))
-> IO (Either String (ActivityResult act))
-> InstanceM (Either String (ActivityResult act))
forall a b. (a -> b) -> a -> b
$ codec -> Payload -> IO (Either String (ActivityResult act))
forall fmt a. Codec fmt a => fmt -> Payload -> IO (Either String a)
decode codec
codec (Payload -> IO (Either String (ActivityResult act)))
-> Payload -> IO (Either String (ActivityResult act))
forall a b. (a -> b) -> a -> b
$ Payload -> Payload
convertFromProtoPayload (Payload -> Payload) -> Payload -> Payload
forall a b. (a -> b) -> a -> b
$ Success
success Success
-> FoldLike Payload Success Success Payload Payload -> Payload
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Payload Success Success Payload Payload
forall (f :: * -> *) s a.
(Functor f, HasField s "result" a) =>
LensLike' f s a
ActivityResult.result
                case result of
                  -- TODO handle properly
                  Left String
err -> String -> InstanceM (Result (ActivityResult act))
forall a. HasCallStack => String -> a
error (String -> InstanceM (Result (ActivityResult act)))
-> String -> InstanceM (Result (ActivityResult act))
forall a b. (a -> b) -> a -> b
$ String
"Failed to decode activity result: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
err
                  Right ActivityResult act
val -> Result (ActivityResult act)
-> InstanceM (Result (ActivityResult act))
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result (ActivityResult act)
 -> InstanceM (Result (ActivityResult act)))
-> Result (ActivityResult act)
-> InstanceM (Result (ActivityResult act))
forall a b. (a -> b) -> a -> b
$ ActivityResult act -> Result (ActivityResult act)
forall a. a -> Result a
Done ActivityResult act
val
              Just (ActivityResult.ActivityResolution'Failed Failure
failure_) ->
                let failure :: Failure
failure = Failure
failure_ Failure
-> FoldLike Failure Failure Failure Failure Failure -> Failure
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Failure Failure Failure Failure Failure
forall (f :: * -> *) s a.
(Functor f, HasField s "failure" a) =>
LensLike' f s a
ActivityResult.failure
                in Result (ActivityResult act)
-> InstanceM (Result (ActivityResult act))
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result (ActivityResult act)
 -> InstanceM (Result (ActivityResult act)))
-> Result (ActivityResult act)
-> InstanceM (Result (ActivityResult act))
forall a b. (a -> b) -> a -> b
$
                    SomeException -> Result (ActivityResult act)
forall a. SomeException -> Result a
Throw (SomeException -> Result (ActivityResult act))
-> SomeException -> Result (ActivityResult act)
forall a b. (a -> b) -> a -> b
$
                      ActivityFailure -> SomeException
forall e. Exception e => e -> SomeException
toException (ActivityFailure -> SomeException)
-> ActivityFailure -> SomeException
forall a b. (a -> b) -> a -> b
$
                        ActivityFailure
                          { message :: Text
message = Failure
failure Failure -> FoldLike Text Failure Failure Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text Failure Failure Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "message" a) =>
LensLike' f s a
Failure.message
                          , activityType :: ActivityType
activityType = Text -> ActivityType
ActivityType Text
n
                          , activityId :: ActivityId
activityId = Text -> ActivityId
ActivityId Text
actId
                          , retryState :: RetryState
retryState = RetryState -> RetryState
retryStateFromProto (RetryState -> RetryState) -> RetryState -> RetryState
forall a b. (a -> b) -> a -> b
$ Failure
failure Failure
-> FoldLike RetryState Failure Failure RetryState RetryState
-> RetryState
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant RetryState) Failure ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "activityFailureInfo" a) =>
LensLike' f s a
Failure.activityFailureInfo LensLike' (Constant RetryState) Failure ActivityFailureInfo
-> ((RetryState -> Constant RetryState RetryState)
    -> ActivityFailureInfo -> Constant RetryState ActivityFailureInfo)
-> FoldLike RetryState Failure Failure RetryState RetryState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RetryState -> Constant RetryState RetryState)
-> ActivityFailureInfo -> Constant RetryState ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "retryState" a) =>
LensLike' f s a
Failure.retryState
                          , identity :: Text
identity = Failure
failure Failure -> FoldLike Text Failure Failure Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant Text) Failure ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "activityFailureInfo" a) =>
LensLike' f s a
Failure.activityFailureInfo LensLike' (Constant Text) Failure ActivityFailureInfo
-> ((Text -> Constant Text Text)
    -> ActivityFailureInfo -> Constant Text ActivityFailureInfo)
-> FoldLike Text Failure Failure Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Constant Text Text)
-> ActivityFailureInfo -> Constant Text ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "identity" a) =>
LensLike' f s a
Failure.identity
                          , cause :: ApplicationFailure
cause =
                              let cause_ :: Failure
cause_ = Failure
failure Failure
-> FoldLike Failure Failure Failure Failure Failure -> Failure
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Failure Failure Failure Failure Failure
forall (f :: * -> *) s a.
(Functor f, HasField s "cause" a) =>
LensLike' f s a
Failure.cause
                              in ApplicationFailure
                                  { type' :: Text
type' = Failure
cause_ Failure -> FoldLike Text Failure Failure Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant Text) Failure ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "applicationFailureInfo" a) =>
LensLike' f s a
Failure.applicationFailureInfo LensLike' (Constant Text) Failure ApplicationFailureInfo
-> ((Text -> Constant Text Text)
    -> ApplicationFailureInfo -> Constant Text ApplicationFailureInfo)
-> FoldLike Text Failure Failure Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Constant Text Text)
-> ApplicationFailureInfo -> Constant Text ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "type'" a) =>
LensLike' f s a
Failure.type'
                                  , message :: Text
message = Failure
cause_ Failure -> FoldLike Text Failure Failure Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text Failure Failure Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "message" a) =>
LensLike' f s a
Failure.message
                                  , nonRetryable :: Bool
nonRetryable = Failure
cause_ Failure -> FoldLike Bool Failure Failure Bool Bool -> Bool
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant Bool) Failure ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "applicationFailureInfo" a) =>
LensLike' f s a
Failure.applicationFailureInfo LensLike' (Constant Bool) Failure ApplicationFailureInfo
-> ((Bool -> Constant Bool Bool)
    -> ApplicationFailureInfo -> Constant Bool ApplicationFailureInfo)
-> FoldLike Bool Failure Failure Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Constant Bool Bool)
-> ApplicationFailureInfo -> Constant Bool ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "nonRetryable" a) =>
LensLike' f s a
Failure.nonRetryable
                                  , details :: [Payload]
details = Failure
cause_ Failure
-> FoldLike [Payload] Failure Failure [Payload] Any -> [Payload]
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant [Payload]) Failure ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "applicationFailureInfo" a) =>
LensLike' f s a
Failure.applicationFailureInfo LensLike' (Constant [Payload]) Failure ApplicationFailureInfo
-> (([Payload] -> Constant [Payload] Any)
    -> ApplicationFailureInfo
    -> Constant [Payload] ApplicationFailureInfo)
-> FoldLike [Payload] Failure Failure [Payload] Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike' (Constant [Payload]) ApplicationFailureInfo Payloads
forall (f :: * -> *) s a.
(Functor f, HasField s "details" a) =>
LensLike' f s a
Failure.details LensLike' (Constant [Payload]) ApplicationFailureInfo Payloads
-> (([Payload] -> Constant [Payload] Any)
    -> Payloads -> Constant [Payload] Payloads)
-> ([Payload] -> Constant [Payload] Any)
-> ApplicationFailureInfo
-> Constant [Payload] ApplicationFailureInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike' (Constant [Payload]) Payloads [Payload]
forall (f :: * -> *) s a.
(Functor f, HasField s "payloads" a) =>
LensLike' f s a
Payloads.payloads LensLike' (Constant [Payload]) Payloads [Payload]
-> (([Payload] -> Constant [Payload] Any)
    -> [Payload] -> Constant [Payload] [Payload])
-> ([Payload] -> Constant [Payload] Any)
-> Payloads
-> Constant [Payload] Payloads
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Payload] -> [Payload])
-> Getter [Payload] [Payload] [Payload] Any
forall s a t b. (s -> a) -> Getter s t a b
to ((Payload -> Payload) -> [Payload] -> [Payload]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertFromProtoPayload)
                                  , stack :: Text
stack = Failure
cause_ Failure -> FoldLike Text Failure Failure Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text Failure Failure Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "stackTrace" a) =>
LensLike' f s a
Failure.stackTrace
                                  , nextRetryDelay :: Maybe Duration
nextRetryDelay = Maybe Duration
forall a. Maybe a
Nothing
                                  }
                          , scheduledEventId :: Int64
scheduledEventId = Failure
failure Failure -> FoldLike Int64 Failure Failure Int64 Int64 -> Int64
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant Int64) Failure ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "activityFailureInfo" a) =>
LensLike' f s a
Failure.activityFailureInfo LensLike' (Constant Int64) Failure ActivityFailureInfo
-> ((Int64 -> Constant Int64 Int64)
    -> ActivityFailureInfo -> Constant Int64 ActivityFailureInfo)
-> FoldLike Int64 Failure Failure Int64 Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Constant Int64 Int64)
-> ActivityFailureInfo -> Constant Int64 ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "scheduledEventId" a) =>
LensLike' f s a
Failure.scheduledEventId
                          , startedEventId :: Int64
startedEventId = Failure
failure Failure -> FoldLike Int64 Failure Failure Int64 Int64 -> Int64
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant Int64) Failure ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "activityFailureInfo" a) =>
LensLike' f s a
Failure.activityFailureInfo LensLike' (Constant Int64) Failure ActivityFailureInfo
-> ((Int64 -> Constant Int64 Int64)
    -> ActivityFailureInfo -> Constant Int64 ActivityFailureInfo)
-> FoldLike Int64 Failure Failure Int64 Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Constant Int64 Int64)
-> ActivityFailureInfo -> Constant Int64 ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "startedEventId" a) =>
LensLike' f s a
Failure.startedEventId
                          , original :: ActivityFailureInfo
original = Failure
failure Failure
-> FoldLike
     ActivityFailureInfo
     Failure
     Failure
     ActivityFailureInfo
     ActivityFailureInfo
-> ActivityFailureInfo
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  ActivityFailureInfo
  Failure
  Failure
  ActivityFailureInfo
  ActivityFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "activityFailureInfo" a) =>
LensLike' f s a
Failure.activityFailureInfo
                          , stack :: Text
stack = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ CallStack -> String
Temporal.Exception.prettyCallStack CallStack
HasCallStack => CallStack
callStack
                          }
              Just (ActivityResult.ActivityResolution'Cancelled Cancellation
details) -> Result (ActivityResult act)
-> InstanceM (Result (ActivityResult act))
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result (ActivityResult act)
 -> InstanceM (Result (ActivityResult act)))
-> Result (ActivityResult act)
-> InstanceM (Result (ActivityResult act))
forall a b. (a -> b) -> a -> b
$ SomeException -> Result (ActivityResult act)
forall a. SomeException -> Result a
Throw (SomeException -> Result (ActivityResult act))
-> SomeException -> Result (ActivityResult act)
forall a b. (a -> b) -> a -> b
$ ActivityCancelled -> SomeException
forall e. Exception e => e -> SomeException
toException (ActivityCancelled -> SomeException)
-> ActivityCancelled -> SomeException
forall a b. (a -> b) -> a -> b
$ Failure -> ActivityCancelled
ActivityCancelled (Cancellation
details Cancellation
-> FoldLike Failure Cancellation Cancellation Failure Failure
-> Failure
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Failure Cancellation Cancellation Failure Failure
forall (f :: * -> *) s a.
(Functor f, HasField s "failure" a) =>
LensLike' f s a
ActivityResult.failure)
              Just (ActivityResult.ActivityResolution'Backoff DoBackoff
_doBackoff) -> String -> InstanceM (Result (ActivityResult act))
forall a. HasCallStack => String -> a
error String
"not implemented"
        , cancelAction = do
            let cancelCmd =
                  WorkflowCommand
forall msg. Message msg => msg
defMessage
                    WorkflowCommand
-> (WorkflowCommand -> WorkflowCommand) -> WorkflowCommand
forall s t. s -> (s -> t) -> t
& LensLike' f WorkflowCommand RequestCancelLocalActivity
forall {f :: * -> *}.
Identical f =>
LensLike' f WorkflowCommand RequestCancelLocalActivity
forall (f :: * -> *) s a.
(Functor f, HasField s "requestCancelLocalActivity" a) =>
LensLike' f s a
Command.requestCancelLocalActivity
                      (forall {f :: * -> *}.
 Identical f =>
 LensLike' f WorkflowCommand RequestCancelLocalActivity)
-> RequestCancelLocalActivity -> WorkflowCommand -> WorkflowCommand
forall s t a b. Setter s t a b -> b -> s -> t
.~ ( RequestCancelLocalActivity
forall msg. Message msg => msg
defMessage
                            RequestCancelLocalActivity
-> (RequestCancelLocalActivity -> RequestCancelLocalActivity)
-> RequestCancelLocalActivity
forall s t. s -> (s -> t) -> t
& LensLike' f RequestCancelLocalActivity Word32
forall {f :: * -> *}.
Identical f =>
LensLike' f RequestCancelLocalActivity Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "seq" a) =>
LensLike' f s a
Command.seq (forall {f :: * -> *}.
 Identical f =>
 LensLike' f RequestCancelLocalActivity Word32)
-> Word32
-> RequestCancelLocalActivity
-> RequestCancelLocalActivity
forall s t a b. Setter s t a b -> b -> s -> t
.~ Word32
actSeq
                         )
            ilift $ addCommand cancelCmd
        }


{- $metadata

Temporal provides a number of ways to access metadata about the current Workflow execution.

Some are useful for debugging (like 'memo', and 'upsertSearchAttributes'), and some are useful for
making decisions about how to proceed (like using 'info' to decide whether to continue-as-new).
-}


{- | We recommend calling 'info' whenever accessing 'Info' fields. Some 'Info' fields change during the lifetime of an Execution—
like historyLength and searchAttributes— and some may be changeable in the future— like taskQueue.
-}
info :: Workflow Info
info :: Workflow Info
info = Workflow WorkflowInstance
askInstance Workflow WorkflowInstance
-> (WorkflowInstance -> Workflow Info) -> Workflow Info
forall a b. Workflow a -> (a -> Workflow b) -> Workflow b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\InstanceM Info
m -> (ContinuationEnv -> InstanceM (Result Info)) -> Workflow Info
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result Info)) -> Workflow Info)
-> (ContinuationEnv -> InstanceM (Result Info)) -> Workflow Info
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> Info -> Result Info
forall a. a -> Result a
Done (Info -> Result Info) -> InstanceM Info -> InstanceM (Result Info)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InstanceM Info
m) (InstanceM Info -> Workflow Info)
-> (WorkflowInstance -> InstanceM Info)
-> WorkflowInstance
-> Workflow Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Info -> InstanceM Info
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (IORef Info -> InstanceM Info)
-> (WorkflowInstance -> IORef Info)
-> WorkflowInstance
-> InstanceM Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkflowInstance -> IORef Info
workflowInstanceInfo


-- (ask >>= readIORef) workflowInstanceInfo <$> askInstance

-- | Current workflow's raw memo values.
getMemoValues :: Workflow (Map Text Payload)
getMemoValues :: Workflow (Map Text Payload)
getMemoValues = (.rawMemo) (Info -> Map Text Payload)
-> Workflow Info -> Workflow (Map Text Payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workflow Info
info


-- | Lookup a memo value by key.
lookupMemoValue :: Text -> Workflow (Maybe Payload)
lookupMemoValue :: Text -> Workflow (Maybe Payload)
lookupMemoValue Text
k = Text -> Map Text Payload -> Maybe Payload
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k (Map Text Payload -> Maybe Payload)
-> Workflow (Map Text Payload) -> Workflow (Maybe Payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workflow (Map Text Payload)
getMemoValues


{- | Updates this Workflow's Search Attributes by merging the provided searchAttributes with the existing Search Attributes

Using this function will overwrite any existing Search Attributes with the same key.
-}
upsertSearchAttributes :: RequireCallStack => Map SearchAttributeKey SearchAttributeType -> Workflow ()
upsertSearchAttributes :: RequireCallStack =>
Map SearchAttributeKey SearchAttributeType -> Workflow ()
upsertSearchAttributes Map SearchAttributeKey SearchAttributeType
values = InstanceM () -> Workflow ()
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM () -> Workflow ()) -> InstanceM () -> Workflow ()
forall a b. (a -> b) -> a -> b
$ do
  InstanceM ()
RequireCallStack => InstanceM ()
updateCallStack
  attrs <- IO (Map Text Payload) -> InstanceM (Map Text Payload)
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map Text Payload) -> InstanceM (Map Text Payload))
-> IO (Map Text Payload) -> InstanceM (Map Text Payload)
forall a b. (a -> b) -> a -> b
$ Map SearchAttributeKey SearchAttributeType -> IO (Map Text Payload)
searchAttributesToProto Map SearchAttributeKey SearchAttributeType
values
  let cmd =
        WorkflowCommand
forall msg. Message msg => msg
defMessage
          WorkflowCommand
-> (WorkflowCommand -> WorkflowCommand) -> WorkflowCommand
forall s t. s -> (s -> t) -> t
& LensLike' f WorkflowCommand UpsertWorkflowSearchAttributes
forall {f :: * -> *}.
Identical f =>
LensLike' f WorkflowCommand UpsertWorkflowSearchAttributes
forall (f :: * -> *) s a.
(Functor f, HasField s "upsertWorkflowSearchAttributes" a) =>
LensLike' f s a
Command.upsertWorkflowSearchAttributes
            (forall {f :: * -> *}.
 Identical f =>
 LensLike' f WorkflowCommand UpsertWorkflowSearchAttributes)
-> UpsertWorkflowSearchAttributes
-> WorkflowCommand
-> WorkflowCommand
forall s t a b. Setter s t a b -> b -> s -> t
.~ ( UpsertWorkflowSearchAttributes
forall msg. Message msg => msg
defMessage
                  UpsertWorkflowSearchAttributes
-> (UpsertWorkflowSearchAttributes
    -> UpsertWorkflowSearchAttributes)
-> UpsertWorkflowSearchAttributes
forall s t. s -> (s -> t) -> t
& LensLike' f UpsertWorkflowSearchAttributes (Map Text Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f UpsertWorkflowSearchAttributes (Map Text Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "searchAttributes" a) =>
LensLike' f s a
Command.searchAttributes (forall {f :: * -> *}.
 Identical f =>
 LensLike' f UpsertWorkflowSearchAttributes (Map Text Payload))
-> Map Text Payload
-> UpsertWorkflowSearchAttributes
-> UpsertWorkflowSearchAttributes
forall s t a b. Setter s t a b -> b -> s -> t
.~ Map Text Payload
attrs
               )
  addCommand cmd
  inst <- ask
  modifyIORef' inst.workflowInstanceInfo $ \Info {Bool
Int
Maybe Text
Maybe Duration
Maybe ParentInfo
Maybe RetryPolicy
Maybe RunId
Word32
Map Text Payload
Map SearchAttributeKey SearchAttributeType
SystemTime
Duration
TaskQueue
RunId
Namespace
WorkflowId
WorkflowType
historyLength :: Word32
attempt :: Int
continuedRunId :: Maybe RunId
cronSchedule :: Maybe Text
executionTimeout :: Maybe Duration
headers :: Map Text Payload
namespace :: Namespace
parent :: Maybe ParentInfo
rawMemo :: Map Text Payload
retryPolicy :: Maybe RetryPolicy
runId :: RunId
runTimeout :: Maybe Duration
searchAttributes :: Map SearchAttributeKey SearchAttributeType
startTime :: SystemTime
taskQueue :: TaskQueue
taskTimeout :: Duration
workflowId :: WorkflowId
workflowType :: WorkflowType
continueAsNewSuggested :: Bool
continueAsNewSuggested :: Info -> Bool
workflowType :: Info -> WorkflowType
workflowId :: Info -> WorkflowId
taskTimeout :: Info -> Duration
taskQueue :: Info -> TaskQueue
startTime :: Info -> SystemTime
searchAttributes :: Info -> Map SearchAttributeKey SearchAttributeType
runTimeout :: Info -> Maybe Duration
runId :: Info -> RunId
retryPolicy :: Info -> Maybe RetryPolicy
rawMemo :: Info -> Map Text Payload
parent :: Info -> Maybe ParentInfo
namespace :: Info -> Namespace
headers :: Info -> Map Text Payload
executionTimeout :: Info -> Maybe Duration
cronSchedule :: Info -> Maybe Text
continuedRunId :: Info -> Maybe RunId
attempt :: Info -> Int
historyLength :: Info -> Word32
..} ->
    Info {searchAttributes :: Map SearchAttributeKey SearchAttributeType
searchAttributes = Map SearchAttributeKey SearchAttributeType
searchAttributes Map SearchAttributeKey SearchAttributeType
-> Map SearchAttributeKey SearchAttributeType
-> Map SearchAttributeKey SearchAttributeType
forall a. Semigroup a => a -> a -> a
<> Map SearchAttributeKey SearchAttributeType
values, Bool
Int
Maybe Text
Maybe Duration
Maybe ParentInfo
Maybe RetryPolicy
Maybe RunId
Word32
Map Text Payload
SystemTime
Duration
TaskQueue
RunId
Namespace
WorkflowId
WorkflowType
historyLength :: Word32
attempt :: Int
continuedRunId :: Maybe RunId
cronSchedule :: Maybe Text
executionTimeout :: Maybe Duration
headers :: Map Text Payload
namespace :: Namespace
parent :: Maybe ParentInfo
rawMemo :: Map Text Payload
retryPolicy :: Maybe RetryPolicy
runId :: RunId
runTimeout :: Maybe Duration
startTime :: SystemTime
taskQueue :: TaskQueue
taskTimeout :: Duration
workflowId :: WorkflowId
workflowType :: WorkflowType
continueAsNewSuggested :: Bool
continueAsNewSuggested :: Bool
workflowType :: WorkflowType
workflowId :: WorkflowId
taskTimeout :: Duration
taskQueue :: TaskQueue
startTime :: SystemTime
runTimeout :: Maybe Duration
runId :: RunId
retryPolicy :: Maybe RetryPolicy
rawMemo :: Map Text Payload
parent :: Maybe ParentInfo
namespace :: Namespace
headers :: Map Text Payload
executionTimeout :: Maybe Duration
cronSchedule :: Maybe Text
continuedRunId :: Maybe RunId
attempt :: Int
historyLength :: Word32
..}


{- | Current time from the workflow perspective.

The time returned is updated only when the workflow performs an
operation in the Workflow monad that blocks. Examples of such operations
are 'sleep', 'awaitCondition', 'awaitActivity', 'awaitWorkflow', etc.

Equivalent to `getCurrentTime` from the `time` package.
-}
now :: Workflow UTCTime
now :: Workflow UTCTime
now = (ContinuationEnv -> InstanceM (Result UTCTime)) -> Workflow UTCTime
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result UTCTime))
 -> Workflow UTCTime)
-> (ContinuationEnv -> InstanceM (Result UTCTime))
-> Workflow UTCTime
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ ->
  UTCTime -> Result UTCTime
forall a. a -> Result a
Done (UTCTime -> Result UTCTime)
-> InstanceM UTCTime -> InstanceM (Result UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    wft <- (WorkflowInstance -> IORef SystemTime)
-> InstanceM (IORef SystemTime)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WorkflowInstance -> IORef SystemTime
workflowTime
    t <- readIORef wft
    pure $! systemToUTCTime t


{- | When using the "Schedules" feature of Temporal, this is the effective time that an instance was scheduled to run,
according to the @TemporalScheduledStartTime@ search attribute.

This is useful for backfilling or retrying a scheduled Workflow if you need the schedule to have a stable start time.
-}
scheduledTime :: Workflow (Maybe UTCTime)
scheduledTime :: Workflow (Maybe UTCTime)
scheduledTime = do
  i <- Workflow Info
info
  pure $ case Map.lookup "TemporalScheduledStartTime" i.searchAttributes of
    Just (Datetime UTCTime
utcTime) ->
      -- The scheduled start time exists and is a datetime, so we can use it
      -- directly.
      UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTCTime
utcTime
    Just (KeywordOrText Text
text)
      | Just UTCTime
utcTime <- Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale String
"%Y-%m-%dT%H:%M:%SZ" (String -> Maybe UTCTime) -> String -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
text ->
          -- The scheduled start time exists as a text value and can be parsed
          -- as a datetime, so we can use it.
          UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTCTime
utcTime
    Maybe SearchAttributeType
_ -> Maybe UTCTime
forall a. Maybe a
Nothing


{- $versioning

Versioning (known as "patching" in the Haskell library) lets you update Workflow Definitions
without causing non-deterministic behavior in current long-running Workflows.

You may need to patch if:

- You want to change the remaining logic of a Workflow while it is still running
- If your new logic can result in a different execution path
-}


applyPatch
  :: RequireCallStack
  => PatchId
  -> Bool
  -- ^ whether the patch is deprecated
  -> Workflow Bool
applyPatch :: RequireCallStack => PatchId -> Bool -> Workflow Bool
applyPatch PatchId
pid Bool
deprecated = InstanceM Bool -> Workflow Bool
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM Bool -> Workflow Bool)
-> InstanceM Bool -> Workflow Bool
forall a b. (a -> b) -> a -> b
$ do
  InstanceM ()
RequireCallStack => InstanceM ()
updateCallStack
  inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
  memoized <- readIORef inst.workflowMemoizedPatches
  case HashMap.lookup pid memoized of
    Just Bool
val -> Bool -> InstanceM Bool
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
val
    Maybe Bool
Nothing -> do
      isReplaying <- IORef Bool -> InstanceM Bool
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef WorkflowInstance
inst.workflowIsReplaying
      notifiedPatches <- readIORef inst.workflowNotifiedPatches
      let usePatch = Bool -> Bool
not Bool
isReplaying Bool -> Bool -> Bool
|| PatchId -> Set PatchId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PatchId
pid Set PatchId
notifiedPatches
      writeIORef inst.workflowMemoizedPatches $ HashMap.insert pid usePatch memoized
      when usePatch $ do
        addCommand $
          defMessage
            & Command.setPatchMarker .~ (defMessage & Command.patchId .~ rawPatchId pid & Command.deprecated .~ deprecated)
      pure usePatch


{- | Patch or upgrade workflow code by checking or stating that this workflow has a certain patch.

See official Temporal docs page for info.

If the workflow is replaying an existing history, then this function returns true if that history
was produced by a worker which also had a patched call with the same patchId.

If the history was produced by a worker without such a call, then it will return false.

If the workflow is not currently replaying, then this call always returns true.

Your workflow code should run the "new" code if this returns true, if it returns false,
you should run the "old" code. By doing this, you can maintain determinism.
-}
patched :: RequireCallStack => PatchId -> Workflow Bool
patched :: RequireCallStack => PatchId -> Workflow Bool
patched PatchId
pid = do
  Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
  RequireCallStack => PatchId -> Bool -> Workflow Bool
PatchId -> Bool -> Workflow Bool
applyPatch PatchId
pid Bool
False


{- | Indicate that a patch is being phased out.

See official Temporal docs page for info.

Workflows with this call may be deployed alongside workflows with a patched call, but they must not be deployed while any workers
still exist running old code without a patched call, or any runs with histories produced by such workers exist.
If either kind of worker encounters a history produced by the other, their behavior is undefined.

Once all live workflow runs have been produced by workers with this call, you can deploy workers which are free of either kind of
patch call for this ID. Workers with and without this call may coexist, as long as they are both running the "new" code.
-}
deprecatePatch :: RequireCallStack => PatchId -> Workflow ()
deprecatePatch :: RequireCallStack => PatchId -> Workflow ()
deprecatePatch PatchId
pid = do
  Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
  Workflow Bool -> Workflow ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Workflow Bool -> Workflow ()) -> Workflow Bool -> Workflow ()
forall a b. (a -> b) -> a -> b
$ RequireCallStack => PatchId -> Bool -> Workflow Bool
PatchId -> Bool -> Workflow Bool
applyPatch PatchId
pid Bool
True


{- $randomness

Workflow executions are deterministic, so you can't use the usual IO-based random number generation.

Instead, each workflow execution is given a seed from the Temporal platform to seed a PRNG. This
allows you to generate random values in a deterministic way.

The 'Workflow' monad provides a 'RandomGen' instance, so you can use the usual 'random' and 'randomR'
functions from the 'System.Random' and 'System.Random.Stateful' modules.
-}


-- | Get a mutable randomness generator for the workflow.
randomGen :: Workflow WorkflowGenM
randomGen :: Workflow WorkflowGenM
randomGen = WorkflowInstance -> WorkflowGenM
workflowRandomnessSeed (WorkflowInstance -> WorkflowGenM)
-> Workflow WorkflowInstance -> Workflow WorkflowGenM
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workflow WorkflowInstance
askInstance


{- | Generate an RFC compliant V4 uuid.

Uses the workflow's deterministic PRNG, making it safe for use within a workflow.

This function is cryptographically insecure.
-}
uuid4 :: Workflow UUID
uuid4 :: Workflow UUID
uuid4 = do
  wft <- WorkflowInstance -> WorkflowGenM
workflowRandomnessSeed (WorkflowInstance -> WorkflowGenM)
-> Workflow WorkflowInstance -> Workflow WorkflowGenM
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workflow WorkflowInstance
askInstance
  sbs <- uniformShortByteString 16 wft
  pure $
    buildFromBytes
      4
      (sbs `SBS.index` 0x0)
      (sbs `SBS.index` 0x1)
      (sbs `SBS.index` 0x2)
      (sbs `SBS.index` 0x3)
      (sbs `SBS.index` 0x4)
      (sbs `SBS.index` 0x5)
      (sbs `SBS.index` 0x6)
      (sbs `SBS.index` 0x7)
      (sbs `SBS.index` 0x8)
      (sbs `SBS.index` 0x9)
      (sbs `SBS.index` 0xA)
      (sbs `SBS.index` 0xB)
      (sbs `SBS.index` 0xC)
      (sbs `SBS.index` 0xD)
      (sbs `SBS.index` 0xE)
      (sbs `SBS.index` 0xF)


{- | Generates a UUIDv7 using the current time (from 'time') and
random data (from 'workflowRandomnessSeed').
-}
uuid7 :: RequireCallStack => Workflow UUID
uuid7 :: RequireCallStack => Workflow UUID
uuid7 = do
  t <- Workflow SystemTime
RequireCallStack => Workflow SystemTime
time
  wft <- workflowRandomnessSeed <$> askInstance
  -- Note that we only need 74 bits (12 + 62) of randomness. That's a little
  -- more than 9 bytes (72 bits), so we have to request 10 bytes (80 bits) of
  -- entropy. The extra 6 bits are discarded.
  b <- uniformShortByteString 10 wft
  pure $
    let u8_u64 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word8 -> Word64
        f = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shift (Word64 -> Int -> Word64)
-> (Int -> Word64) -> Int -> Int -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
u8_u64 (Word8 -> Word64) -> (Int -> Word8) -> Int -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ShortByteString -> Int -> Word8
ShortByteString -> Int -> Word8
SBS.index ShortByteString
b
        r = Int -> Int -> Word64
f Int
0 Int
0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
1 Int
8
        s = Int -> Int -> Word64
f Int
2 Int
0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
3 Int
8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
4 Int
16 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
5 Int
24 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
6 Int
32 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
7 Int
40 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
8 Int
48 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
9 Int
56
    in buildV7 t r s
  where
    buildV7
      -- Corresponds to the @unix_ts_ms@ field.
      :: SystemTime
      -- Corresponds to the @rand_a@ field. Only the low 12 bits are used.
      -> Word64
      -- Corresponds to the @rand_b@ field. Only the low 62 bits are used.
      -> Word64
      -> UUID.UUID
    buildV7 :: SystemTime -> Word64 -> Word64 -> UUID
buildV7 SystemTime
t Word64
r Word64
s =
      let i64_u64 :: Int64 -> Word64
i64_u64 = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int64 -> Word64
          u32_u64 :: Word32 -> Word64
u32_u64 = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word32 -> Word64
          unix_ts_ms :: Word64
unix_ts_ms =
            Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shift
              ( (Int64 -> Word64
i64_u64 (SystemTime -> Int64
systemSeconds SystemTime
t) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000)
                  Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word32 -> Word64
u32_u64 (Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
div (SystemTime -> Word32
systemNanoseconds SystemTime
t) Word32
1000000)
              )
              Int
16
          ver :: Word64
ver = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shift Word64
0x7 Int
12 :: Word64
          rand_a :: Word64
rand_a = Word64
r Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
Bits..&. Word64
0x0fff
          var :: Word64
var = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shift Word64
0x2 Int
62 :: Word64
          rand_b :: Word64
rand_b = Word64
s Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
Bits..&. Word64
0x3fffffffffffffff
      in Word64 -> Word64 -> UUID
UUID.fromWords64 (Word64
unix_ts_ms Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
ver Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
rand_a) (Word64
var Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
rand_b)


{- $queries

A Query is a synchronous operation that is used to get the state of a Workflow Execution.
The state of a running Workflow Execution is constantly changing.
You can use Queries to expose the internal Workflow Execution state to the external world.
Queries are available for running or completed Workflows Executions only if the Worker is
up and listening on the Task Queue.

Queries are strongly consistent and are guaranteed to return the most recent state.
This means that the data reflects the state of all confirmed Events that came in before
the Query was sent. An Event is considered confirmed if the call creating the Event returned
success. Events that are created while the Query is outstanding may or may not be reflected
in the Workflow state the Query result is based on.

A Query can carry arguments to specify the data it is requesting. And each Workflow can expose data to multiple types of Queries.

A Query cannot mutate the state of the Workflow Execution— that is, Queries are read-only and cannot contain any blocking code.
This means, for example, that Query handling logic cannot schedule Activity Executions.
-}


{- | Register a query handler.

The handler will be called when a query with the given name is received.
-}
setQueryHandler
  :: forall query f
   . ( QueryRef query
     , f ~ (QueryArgs query :->: Query (QueryResult query))
     , RequireCallStack
     )
  => query
  -> f
  -> Workflow ()
setQueryHandler :: forall query f.
(QueryRef query,
 f ~ (QueryArgs query :->: Query (QueryResult query)),
 RequireCallStack) =>
query -> f -> Workflow ()
setQueryHandler (query -> KnownQuery (QueryArgs query) (QueryResult query)
forall query.
QueryRef query =>
query -> KnownQuery (QueryArgs query) (QueryResult query)
queryRef -> KnownQuery Text
n codec
codec) f
f = InstanceM () -> Workflow ()
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM () -> Workflow ()) -> InstanceM () -> Workflow ()
forall a b. (a -> b) -> a -> b
$ do
  InstanceM ()
RequireCallStack => InstanceM ()
updateCallStack
  inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
  withRunInIO $ \forall a. InstanceM a -> IO a
runInIO -> do
    IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef
  (HashMap
     (Maybe Text)
     (QueryId
      -> Vector Payload
      -> Map Text Payload
      -> IO (Either SomeException Payload)))
-> (HashMap
      (Maybe Text)
      (QueryId
       -> Vector Payload
       -> Map Text Payload
       -> IO (Either SomeException Payload))
    -> HashMap
         (Maybe Text)
         (QueryId
          -> Vector Payload
          -> Map Text Payload
          -> IO (Either SomeException Payload)))
-> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' WorkflowInstance
inst.workflowQueryHandlers ((HashMap
    (Maybe Text)
    (QueryId
     -> Vector Payload
     -> Map Text Payload
     -> IO (Either SomeException Payload))
  -> HashMap
       (Maybe Text)
       (QueryId
        -> Vector Payload
        -> Map Text Payload
        -> IO (Either SomeException Payload)))
 -> IO ())
-> (HashMap
      (Maybe Text)
      (QueryId
       -> Vector Payload
       -> Map Text Payload
       -> IO (Either SomeException Payload))
    -> HashMap
         (Maybe Text)
         (QueryId
          -> Vector Payload
          -> Map Text Payload
          -> IO (Either SomeException Payload)))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \HashMap
  (Maybe Text)
  (QueryId
   -> Vector Payload
   -> Map Text Payload
   -> IO (Either SomeException Payload))
handles ->
      Maybe Text
-> (QueryId
    -> Vector Payload
    -> Map Text Payload
    -> IO (Either SomeException Payload))
-> HashMap
     (Maybe Text)
     (QueryId
      -> Vector Payload
      -> Map Text Payload
      -> IO (Either SomeException Payload))
-> HashMap
     (Maybe Text)
     (QueryId
      -> Vector Payload
      -> Map Text Payload
      -> IO (Either SomeException Payload))
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n) (\QueryId
qId Vector Payload
vec Map Text Payload
hdrs -> InstanceM (Either SomeException Payload)
-> IO (Either SomeException Payload)
forall a. InstanceM a -> IO a
runInIO (InstanceM (Either SomeException Payload)
 -> IO (Either SomeException Payload))
-> InstanceM (Either SomeException Payload)
-> IO (Either SomeException Payload)
forall a b. (a -> b) -> a -> b
$ QueryId
-> Vector Payload
-> Map Text Payload
-> InstanceM (Either SomeException Payload)
qHandler QueryId
qId Vector Payload
vec Map Text Payload
hdrs) HashMap
  (Maybe Text)
  (QueryId
   -> Vector Payload
   -> Map Text Payload
   -> IO (Either SomeException Payload))
handles
  where
    qHandler :: QueryId -> Vector Payload -> Map Text Payload -> InstanceM (Either SomeException Payload)
    qHandler :: QueryId
-> Vector Payload
-> Map Text Payload
-> InstanceM (Either SomeException Payload)
qHandler (QueryId Text
_) Vector Payload
vec Map Text Payload
_ = do
      eHandler <-
        IO (Either String (Query (QueryResult query)))
-> InstanceM (Either String (Query (QueryResult query)))
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String (Query (QueryResult query)))
 -> InstanceM (Either String (Query (QueryResult query))))
-> IO (Either String (Query (QueryResult query)))
-> InstanceM (Either String (Query (QueryResult query)))
forall a b. (a -> b) -> a -> b
$
          codec
-> Proxy (QueryArgs query)
-> Proxy (Query (QueryResult query))
-> (QueryArgs query :->: Query (QueryResult query))
-> Vector Payload
-> IO (Either String (Query (QueryResult query)))
forall result.
codec
-> Proxy (QueryArgs query)
-> Proxy result
-> (QueryArgs query :->: result)
-> Vector Payload
-> IO (Either String result)
forall codec (args :: [*]) result.
ApplyPayloads codec args =>
codec
-> Proxy args
-> Proxy result
-> (args :->: result)
-> Vector Payload
-> IO (Either String result)
applyPayloads
            codec
codec
            (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(QueryArgs query))
            (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Query (QueryResult query)))
            f
QueryArgs query :->: Query (QueryResult query)
f
            Vector Payload
vec
      -- TODO handle exceptions properly
      case eHandler of
        Left String
err -> Either SomeException Payload
-> InstanceM (Either SomeException Payload)
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException Payload
 -> InstanceM (Either SomeException Payload))
-> Either SomeException Payload
-> InstanceM (Either SomeException Payload)
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException Payload
forall a b. a -> Either a b
Left (SomeException -> Either SomeException Payload)
-> SomeException -> Either SomeException Payload
forall a b. (a -> b) -> a -> b
$ ValueError -> SomeException
forall e. Exception e => e -> SomeException
toException (ValueError -> SomeException) -> ValueError -> SomeException
forall a b. (a -> b) -> a -> b
$ String -> ValueError
ValueError String
err
        Right (Query InstanceM (QueryResult query)
r) -> do
          eResult <- InstanceM (QueryResult query)
-> InstanceM (Either SomeException (QueryResult query))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
UnliftIO.try InstanceM (QueryResult query)
r
          case eResult of
            Left SomeException
err -> Either SomeException Payload
-> InstanceM (Either SomeException Payload)
forall a. a -> InstanceM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException Payload
 -> InstanceM (Either SomeException Payload))
-> Either SomeException Payload
-> InstanceM (Either SomeException Payload)
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException Payload
forall a b. a -> Either a b
Left SomeException
err
            Right QueryResult query
result -> IO (Either SomeException Payload)
-> InstanceM (Either SomeException Payload)
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException Payload)
 -> InstanceM (Either SomeException Payload))
-> IO (Either SomeException Payload)
-> InstanceM (Either SomeException Payload)
forall a b. (a -> b) -> a -> b
$ UnencodedPayload -> IO (Either SomeException Payload)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
UnliftIO.try (UnencodedPayload -> IO (Either SomeException Payload))
-> UnencodedPayload -> IO (Either SomeException Payload)
forall a b. (a -> b) -> a -> b
$ codec -> QueryResult query -> UnencodedPayload
forall fmt a. Codec fmt a => fmt -> a -> UnencodedPayload
encode codec
codec QueryResult query
result


type ValidSignalHandler f =
  ( ResultOf Workflow f ~ ()
  , (ArgsOf f :->: Workflow ()) ~ f
  )


setSignalHandler
  :: forall f ref
   . ( ValidSignalHandler f
     , RequireCallStack
     , SignalRef ref
     , ArgsOf f ~ SignalArgs ref
     )
  => ref
  -> f
  -> Workflow ()
setSignalHandler :: forall f ref.
(ValidSignalHandler f, RequireCallStack, SignalRef ref,
 ArgsOf f ~ SignalArgs ref) =>
ref -> f -> Workflow ()
setSignalHandler (ref -> KnownSignal (SignalArgs ref)
forall sig. SignalRef sig => sig -> KnownSignal (SignalArgs sig)
signalRef -> KnownSignal Text
n codec
codec) f
f = InstanceM () -> Workflow ()
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM () -> Workflow ()) -> InstanceM () -> Workflow ()
forall a b. (a -> b) -> a -> b
$ do
  InstanceM ()
RequireCallStack => InstanceM ()
updateCallStack
  -- TODO ^ inner callstack?
  inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
  liftIO $ modifyIORef' inst.workflowSignalHandlers $ \HashMap (Maybe Text) (Vector Payload -> Workflow ())
handlers ->
    Maybe Text
-> (Vector Payload -> Workflow ())
-> HashMap (Maybe Text) (Vector Payload -> Workflow ())
-> HashMap (Maybe Text) (Vector Payload -> Workflow ())
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n) Vector Payload -> Workflow ()
handle' HashMap (Maybe Text) (Vector Payload -> Workflow ())
handlers
  where
    handle' :: Vector Payload -> Workflow ()
    handle' :: Vector Payload -> Workflow ()
handle' Vector Payload
vec = do
      eWorkflow <- (ContinuationEnv
 -> InstanceM (Result (Either String (Workflow ()))))
-> Workflow (Either String (Workflow ()))
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv
  -> InstanceM (Result (Either String (Workflow ()))))
 -> Workflow (Either String (Workflow ())))
-> (ContinuationEnv
    -> InstanceM (Result (Either String (Workflow ()))))
-> Workflow (Either String (Workflow ()))
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_env ->
        IO (Result (Either String (Workflow ())))
-> InstanceM (Result (Either String (Workflow ())))
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result (Either String (Workflow ())))
 -> InstanceM (Result (Either String (Workflow ()))))
-> IO (Result (Either String (Workflow ())))
-> InstanceM (Result (Either String (Workflow ())))
forall a b. (a -> b) -> a -> b
$
          Either String (Workflow ()) -> Result (Either String (Workflow ()))
forall a. a -> Result a
Done
            (Either String (Workflow ())
 -> Result (Either String (Workflow ())))
-> IO (Either String (Workflow ()))
-> IO (Result (Either String (Workflow ())))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> codec
-> Proxy (SignalArgs ref)
-> Proxy (Workflow ())
-> (SignalArgs ref :->: Workflow ())
-> Vector Payload
-> IO (Either String (Workflow ()))
forall result.
codec
-> Proxy (SignalArgs ref)
-> Proxy result
-> (SignalArgs ref :->: result)
-> Vector Payload
-> IO (Either String result)
forall codec (args :: [*]) result.
ApplyPayloads codec args =>
codec
-> Proxy args
-> Proxy result
-> (args :->: result)
-> Vector Payload
-> IO (Either String result)
applyPayloads
              codec
codec
              (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ArgsOf f))
              (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Workflow ()))
              f
SignalArgs ref :->: Workflow ()
f
              Vector Payload
vec
      case eWorkflow of
        Left String
err -> ValueError -> Workflow ()
forall e a. (HasCallStack, Exception e) => e -> Workflow a
throw (ValueError -> Workflow ()) -> ValueError -> Workflow ()
forall a b. (a -> b) -> a -> b
$ String -> ValueError
ValueError String
err
        Right Workflow ()
w -> Workflow ()
w


{- | Current time from the workflow perspective.

The value is relative to epoch time.
-}
time :: RequireCallStack => Workflow SystemTime
time :: RequireCallStack => Workflow SystemTime
time = InstanceM SystemTime -> Workflow SystemTime
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM SystemTime -> Workflow SystemTime)
-> InstanceM SystemTime -> Workflow SystemTime
forall a b. (a -> b) -> a -> b
$ do
  InstanceM ()
RequireCallStack => InstanceM ()
updateCallStack
  wft <- (WorkflowInstance -> IORef SystemTime)
-> InstanceM (IORef SystemTime)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WorkflowInstance -> IORef SystemTime
workflowTime
  readIORef wft


data Timer = Timer
  { Timer -> Sequence
timerSequence :: Sequence
  , Timer -> IVar ()
timerHandle :: IVar ()
  }


{- | Asynchronous sleep.

Creates a timer that fires after the specified duration.

The timer is not guaranteed to fire immediately after the duration expires,
but it is intended to fire as close to the expiration as possible.

Note that the timer is started when the command is received by the Temporal Platform,
not when the timer is created. The command is sent as soon as the workflow is blocked
by any operation, such as 'sleep', 'awaitCondition', 'awaitActivity', 'awaitWorkflow', etc.

If the duration is less than or equal to zero, the timer will not be created.
-}
createTimer :: Duration -> Workflow (Maybe Timer)
createTimer :: Duration -> Workflow (Maybe Timer)
createTimer Duration
ts = (RequireCallStackImpl => Workflow (Maybe Timer))
-> Workflow (Maybe Timer)
forall r. (RequireCallStackImpl => r) -> r
provideCallStack ((RequireCallStackImpl => Workflow (Maybe Timer))
 -> Workflow (Maybe Timer))
-> (RequireCallStackImpl => Workflow (Maybe Timer))
-> Workflow (Maybe Timer)
forall a b. (a -> b) -> a -> b
$ InstanceM (Maybe Timer) -> Workflow (Maybe Timer)
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM (Maybe Timer) -> Workflow (Maybe Timer))
-> InstanceM (Maybe Timer) -> Workflow (Maybe Timer)
forall a b. (a -> b) -> a -> b
$ do
  inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
  s@(Sequence seqId) <- nextTimerSequence
  if ts <= mempty
    then pure Nothing
    else do
      let ts' = if Duration
ts Duration -> Duration -> Bool
forall a. Ord a => a -> a -> Bool
<= Duration
forall a. Monoid a => a
mempty then Integer -> Duration
nanoseconds Integer
1 else Duration
ts
          cmd =
            WorkflowCommand
forall msg. Message msg => msg
defMessage
              WorkflowCommand
-> (WorkflowCommand -> WorkflowCommand) -> WorkflowCommand
forall s t. s -> (s -> t) -> t
& LensLike' f WorkflowCommand StartTimer
forall {f :: * -> *}.
Identical f =>
LensLike' f WorkflowCommand StartTimer
forall (f :: * -> *) s a.
(Functor f, HasField s "startTimer" a) =>
LensLike' f s a
Command.startTimer
                (forall {f :: * -> *}.
 Identical f =>
 LensLike' f WorkflowCommand StartTimer)
-> StartTimer -> WorkflowCommand -> WorkflowCommand
forall s t a b. Setter s t a b -> b -> s -> t
.~ ( StartTimer
forall msg. Message msg => msg
defMessage
                      StartTimer -> (StartTimer -> StartTimer) -> StartTimer
forall s t. s -> (s -> t) -> t
& LensLike' f StartTimer Word32
forall {f :: * -> *}. Identical f => LensLike' f StartTimer Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "seq" a) =>
LensLike' f s a
Command.seq (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartTimer Word32)
-> Word32 -> StartTimer -> StartTimer
forall s t a b. Setter s t a b -> b -> s -> t
.~ Word32
seqId
                      StartTimer -> (StartTimer -> StartTimer) -> StartTimer
forall s t. s -> (s -> t) -> t
& LensLike' f StartTimer Duration
forall {f :: * -> *}.
Identical f =>
LensLike' f StartTimer Duration
forall (f :: * -> *) s a.
(Functor f, HasField s "startToFireTimeout" a) =>
LensLike' f s a
Command.startToFireTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StartTimer Duration)
-> Duration -> StartTimer -> StartTimer
forall s t a b. Setter s t a b -> b -> s -> t
.~ Duration -> Duration
durationToProto Duration
ts'
                   )
      $(logDebug) "Add command: sleep"
      res <- newIVar
      atomically $ modifyTVar' inst.workflowSequenceMaps $ \SequenceMaps
seqMaps ->
        SequenceMaps
seqMaps {timers = HashMap.insert s res seqMaps.timers}
      addCommand cmd
      pure $ Just $ Timer {timerSequence = s, timerHandle = res}


sleep :: RequireCallStack => Duration -> Workflow ()
sleep :: RequireCallStack => Duration -> Workflow ()
sleep Duration
ts = do
  Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
  t <- Duration -> Workflow (Maybe Timer)
createTimer Duration
ts
  mapM_ Temporal.Workflow.Unsafe.Handle.wait t


instance Wait Timer where
  type WaitResult Timer = Workflow ()
  wait :: RequireCallStack => Timer -> WaitResult Timer
  wait :: RequireCallStack => Timer -> WaitResult Timer
wait Timer
t = do
    Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
    IVar () -> Workflow ()
forall a. IVar a -> Workflow a
getIVar (IVar () -> Workflow ()) -> IVar () -> Workflow ()
forall a b. (a -> b) -> a -> b
$ Timer -> IVar ()
timerHandle Timer
t


instance Cancel Timer where
  type CancelResult Timer = Workflow ()


  cancel :: RequireCallStack => Timer -> CancelResult Timer
cancel Timer
t = (ContinuationEnv -> InstanceM (Result ())) -> Workflow ()
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result ())) -> Workflow ())
-> (ContinuationEnv -> InstanceM (Result ())) -> Workflow ()
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> do
    InstanceM ()
RequireCallStack => InstanceM ()
updateCallStack
    inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
    let cmd =
          WorkflowCommand
forall msg. Message msg => msg
defMessage
            WorkflowCommand
-> (WorkflowCommand -> WorkflowCommand) -> WorkflowCommand
forall s t. s -> (s -> t) -> t
& LensLike' f WorkflowCommand CancelTimer
forall {f :: * -> *}.
Identical f =>
LensLike' f WorkflowCommand CancelTimer
forall (f :: * -> *) s a.
(Functor f, HasField s "cancelTimer" a) =>
LensLike' f s a
Command.cancelTimer
              (forall {f :: * -> *}.
 Identical f =>
 LensLike' f WorkflowCommand CancelTimer)
-> CancelTimer -> WorkflowCommand -> WorkflowCommand
forall s t a b. Setter s t a b -> b -> s -> t
.~ ( CancelTimer
forall msg. Message msg => msg
defMessage
                    CancelTimer -> (CancelTimer -> CancelTimer) -> CancelTimer
forall s t. s -> (s -> t) -> t
& LensLike' f CancelTimer Word32
forall {f :: * -> *}. Identical f => LensLike' f CancelTimer Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "seq" a) =>
LensLike' f s a
Command.seq (forall {f :: * -> *}.
 Identical f =>
 LensLike' f CancelTimer Word32)
-> Word32 -> CancelTimer -> CancelTimer
forall s t a b. Setter s t a b -> b -> s -> t
.~ Sequence -> Word32
rawSequence (Timer -> Sequence
timerSequence Timer
t)
                 )
    addCommand cmd
    $(logDebug) "about to putIVar: cancelTimer"
    liftIO $
      putIVar
        t.timerHandle
        (Ok ())
        inst.workflowInstanceContinuationEnv

    atomically $ modifyTVar' inst.workflowSequenceMaps $ \SequenceMaps
seqMaps ->
      SequenceMaps
seqMaps {timers = HashMap.delete t.timerSequence seqMaps.timers}

    $(logDebug) "finished putIVar: cancelTimer"
    pure $ Done ()


{- | Continue-As-New is a mechanism by which the latest relevant state is passed to a new Workflow Execution, with a fresh Event History.

As a precautionary measure, the Temporal Platform limits the total Event History to 51,200 Events or 50 MB, and will warn you after
10,240 Events or 10 MB. To prevent a Workflow Execution Event History from exceeding this limit and failing,
use Continue-As-New to start a new Workflow Execution with a fresh Event History.

All values passed to a Workflow Execution through parameters or returned through a result value are recorded into the Event History.
A Temporal Cluster stores the full Event History of a Workflow Execution for the duration of a Namespace's retention period.
A Workflow Execution that periodically executes many Activities has the potential of hitting the size limit.

A very large Event History can adversely affect the performance of a Workflow Execution. For example, in the case of a Workflow Worker failure,
the full Event History must be pulled from the Temporal Cluster and given to another Worker via a Workflow Task.
If the Event history is very large, it may take some time to load it.

The Continue-As-New feature enables developers to complete the current Workflow Execution and start a new one atomically.

The new Workflow Execution has the same Workflow Id, but a different Run Id, and has its own Event History.
TODO, don't make this an exception, make it a return value
-}
continueAsNew
  :: forall wf
   . WorkflowRef wf
  => wf
  -- ^ The workflow to continue as new. It doesn't have to be the same as the current workflow.
  -> ContinueAsNewOptions
  -> (WorkflowArgs wf :->: Workflow (WorkflowResult wf))
continueAsNew :: forall wf.
WorkflowRef wf =>
wf
-> ContinueAsNewOptions
-> WorkflowArgs wf :->: Workflow (WorkflowResult wf)
continueAsNew (wf -> KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf)
forall f.
WorkflowRef f =>
f -> KnownWorkflow (WorkflowArgs f) (WorkflowResult f)
workflowRef -> k :: KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf)
k@(KnownWorkflow codec
codec Text
_)) ContinueAsNewOptions
opts = forall (args :: [*]) result codec.
(VarArgs args, AllArgs (Codec codec) args) =>
codec
-> (Vector Payload -> Workflow result) -> args :->: Workflow result
withWorkflowArgs @(WorkflowArgs wf) @(WorkflowResult wf) codec
codec ((Vector Payload -> Workflow (WorkflowResult wf))
 -> WorkflowArgs wf :->: Workflow (WorkflowResult wf))
-> (Vector Payload -> Workflow (WorkflowResult wf))
-> WorkflowArgs wf :->: Workflow (WorkflowResult wf)
forall a b. (a -> b) -> a -> b
$ \Vector Payload
args -> do
  (ContinuationEnv -> InstanceM (Result (WorkflowResult wf)))
-> Workflow (WorkflowResult wf)
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result (WorkflowResult wf)))
 -> Workflow (WorkflowResult wf))
-> (ContinuationEnv -> InstanceM (Result (WorkflowResult wf)))
-> Workflow (WorkflowResult wf)
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
_ -> do
    inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
    res <- liftIO $ (Temporal.Workflow.Internal.Monad.continueAsNew inst.outboundInterceptor) (knownWorkflowName k) opts $ \Text
wfName (ContinueAsNewOptions
opts' :: ContinueAsNewOptions) -> do
      -- searchAttrs <- searchAttributesToProto
      --     (if opts'.searchAttributes == mempty
      --       then i.searchAttributes
      --       else opts'.searchAttributes)
      ContinueAsNewException -> IO (WorkflowResult wf)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ContinueAsNewException -> IO (WorkflowResult wf))
-> ContinueAsNewException -> IO (WorkflowResult wf)
forall a b. (a -> b) -> a -> b
$ WorkflowType
-> Vector Payload -> ContinueAsNewOptions -> ContinueAsNewException
ContinueAsNewException (Text -> WorkflowType
WorkflowType Text
wfName) Vector Payload
args ContinueAsNewOptions
opts'
    pure $ Done res


-- | Returns a client-side handle that can be used to signal and cancel an existing Workflow execution. It takes a Workflow ID and optional run ID.
getExternalWorkflowHandle :: RequireCallStack => WorkflowId -> Maybe RunId -> Workflow (ExternalWorkflowHandle result)
getExternalWorkflowHandle :: forall result.
RequireCallStack =>
WorkflowId
-> Maybe RunId -> Workflow (ExternalWorkflowHandle result)
getExternalWorkflowHandle WorkflowId
wfId Maybe RunId
mrId = do
  Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
  ExternalWorkflowHandle result
-> Workflow (ExternalWorkflowHandle result)
forall a. a -> Workflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExternalWorkflowHandle result
 -> Workflow (ExternalWorkflowHandle result))
-> ExternalWorkflowHandle result
-> Workflow (ExternalWorkflowHandle result)
forall a b. (a -> b) -> a -> b
$
    ExternalWorkflowHandle
      { externalWorkflowWorkflowId :: WorkflowId
externalWorkflowWorkflowId = WorkflowId
wfId
      , externalWorkflowRunId :: Maybe RunId
externalWorkflowRunId = Maybe RunId
mrId
      }


{- | Wait on a condition to become true before continuing.

This must be used with signals, steps executed concurrently via the Applicative instance,
or with the `race` command, as those are the only way for
state to change in a workflow while a portion of the workflow itself is
in this blocking condition.

N.B. this should be used with care, as it can lead to the workflow
suspending indefinitely if the condition is never met.
(e.g. if there is no signal handler that changes the state appropriately)
-}
waitCondition :: RequireCallStack => Condition Bool -> Workflow ()
waitCondition :: RequireCallStack => Condition Bool -> Workflow ()
waitCondition c :: Condition Bool
c@(Condition ReaderT (IORef (Set Sequence)) InstanceM Bool
m) = do
  Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
  (conditionSatisfied, touchedVars) <- InstanceM (Bool, Set Sequence) -> Workflow (Bool, Set Sequence)
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM (Bool, Set Sequence) -> Workflow (Bool, Set Sequence))
-> InstanceM (Bool, Set Sequence) -> Workflow (Bool, Set Sequence)
forall a b. (a -> b) -> a -> b
$ do
    sRef <- Set Sequence -> InstanceM (IORef (Set Sequence))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Set Sequence
forall a. Monoid a => a
mempty
    sat <- runReaderT m sRef
    (,) sat <$> readIORef sRef
  if conditionSatisfied
    then pure ()
    else go touchedVars
  where
    -- When blocked, the condition needs to be rechecked every time a signal is received
    -- or a new resolutions are received from a workflow activation.
    go :: Set Sequence -> Workflow ()
go Set Sequence
touchedVars = do
      blockedVar <- InstanceM (IVar ()) -> Workflow (IVar ())
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM (IVar ()) -> Workflow (IVar ()))
-> InstanceM (IVar ()) -> Workflow (IVar ())
forall a b. (a -> b) -> a -> b
$ do
        inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
        res <- newIVar
        conditionSeq <- nextConditionSequence
        atomically $ modifyTVar' inst.workflowSequenceMaps $ \SequenceMaps
seqMaps ->
          SequenceMaps
seqMaps
            { conditionsAwaitingSignal = HashMap.insert conditionSeq (res, touchedVars) seqMaps.conditionsAwaitingSignal
            }
        pure res
      -- Wait for the condition to be signaled. Once signalled, we just try again.
      -- writeStateVar and friends are in charge of filling the ivar and clearing out the seqmaps between rechecks
      getIVar blockedVar
      waitCondition c


{- | While workflows are deterministic, there are categories of operational concerns (metrics, logging, tracing, etc.) that require
access to IO operations like the network or filesystem. The 'IO' monad is not generally available in the 'Workflow' monad, but you
can use 'sink' to run an 'IO' action in a workflow. In order to maintain determinism, the operation will be executed asynchronously
and does not return a value. Be sure that the sink operation terminates, or else you will leak memory and/or threads.

Do not use 'sink' for any Workflow logic, or else you will violate determinism.
-}
unsafeAsyncEffectSink :: RequireCallStack => IO () -> Workflow ()
unsafeAsyncEffectSink :: RequireCallStack => IO () -> Workflow ()
unsafeAsyncEffectSink IO ()
m = do
  Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
  InstanceM () -> Workflow ()
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM () -> Workflow ()) -> InstanceM () -> Workflow ()
forall a b. (a -> b) -> a -> b
$ IO () -> InstanceM ()
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> InstanceM ()) -> IO () -> InstanceM ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO IO ()
m


-- -----------------------------------------------------------------------------
-- Parallel operations

{-
If either workflow completes with a Left a result, the computation will short-circuit and immediately return @Left a@.
This means that if one branch produces a 'Left' result, the other branch's computation will be aborted if it hasn't already completed.

If both workflows complete with Right results, the function will return @Right (b, c)@.
In this case, both branches will be fully evaluated.
-}
biselect
  :: RequireCallStack
  => Workflow (Either a b)
  -> Workflow (Either a c)
  -> Workflow (Either a (b, c))
biselect :: forall a b c.
RequireCallStack =>
Workflow (Either a b)
-> Workflow (Either a c) -> Workflow (Either a (b, c))
biselect = (Either a b -> Either a b)
-> (Either a c -> Either a c)
-> (a -> Either a (b, c))
-> ((b, c) -> Either a (b, c))
-> Workflow (Either a b)
-> Workflow (Either a c)
-> Workflow (Either a (b, c))
forall l a b r c t.
RequireCallStack =>
(l -> Either a b)
-> (r -> Either a c)
-> (a -> t)
-> ((b, c) -> t)
-> Workflow l
-> Workflow r
-> Workflow t
biselectOpt Either a b -> Either a b
forall a. a -> a
id Either a c -> Either a c
forall a. a -> a
id a -> Either a (b, c)
forall a b. a -> Either a b
Left (b, c) -> Either a (b, c)
forall a b. b -> Either a b
Right


{- | The 'biselectOpt' function combines two workflows and applies optimized selection logic.

This function is inspired by the 'Haxl' library's Haxl.Core.Parallel functions. It takes two workflows
and combines them, applying discrimination functions to their results to determine the final outcome.
The function works as follows:

1. It explores both workflows concurrently.

2. If the left workflow completes first:
   - If the first argument returns 'Left', the result is immediately returned using the third function.
   - If the first argument returns 'Right', it waits for the right workflow to complete.

3. If the right workflow completes first:
   - If the second argument returns 'Left', the result is immediately returned using the third function.
   - If the second argument returns 'Right', it waits for the left workflow to complete.

4. If both workflows complete:
   - The results are combined using the fourth function if both discriminators return 'Right'.

5. If either workflow throws an exception, the exception is propagated.

6. If either workflow is blocked, the function manages the blocking and resumption of computation.

This function optimizes the execution by short-circuiting when possible and managing concurrency
efficiently. Be cautious when using this function, as exceptions and evaluation order can be
unpredictable depending on the discriminator functions provided.
-}
{-# INLINE biselectOpt #-}
biselectOpt
  :: RequireCallStack
  => (l -> Either a b)
  -> (r -> Either a c)
  -> (a -> t)
  -> ((b, c) -> t)
  -> Workflow l
  -> Workflow r
  -> Workflow t
biselectOpt :: forall l a b r c t.
RequireCallStack =>
(l -> Either a b)
-> (r -> Either a c)
-> (a -> t)
-> ((b, c) -> t)
-> Workflow l
-> Workflow r
-> Workflow t
biselectOpt l -> Either a b
discrimA r -> Either a c
discrimB a -> t
left (b, c) -> t
right Workflow l
wfL Workflow r
wfR =
  let go :: Workflow l -> Workflow r -> Workflow t
go (Workflow ContinuationEnv -> InstanceM (Result l)
wfA) (Workflow ContinuationEnv -> InstanceM (Result r)
wfB) = (ContinuationEnv -> InstanceM (Result t)) -> Workflow t
forall a. (ContinuationEnv -> InstanceM (Result a)) -> Workflow a
Workflow ((ContinuationEnv -> InstanceM (Result t)) -> Workflow t)
-> (ContinuationEnv -> InstanceM (Result t)) -> Workflow t
forall a b. (a -> b) -> a -> b
$ \ContinuationEnv
env -> do
        ra <- ContinuationEnv -> InstanceM (Result l)
wfA ContinuationEnv
env
        case ra of
          Done l
ea ->
            case l -> Either a b
discrimA l
ea of
              Left a
a -> Result t -> InstanceM (Result t)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> Result t
forall a. a -> Result a
Done (a -> t
left a
a))
              Right b
b -> do
                rb <- ContinuationEnv -> InstanceM (Result r)
wfB ContinuationEnv
env
                case rb of
                  Done r
eb ->
                    case r -> Either a c
discrimB r
eb of
                      Left a
a -> Result t -> InstanceM (Result t)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> Result t
forall a. a -> Result a
Done (a -> t
left a
a))
                      Right c
c -> Result t -> InstanceM (Result t)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> Result t
forall a. a -> Result a
Done ((b, c) -> t
right (b
b, c
c)))
                  Throw SomeException
e -> Result t -> InstanceM (Result t)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Result t
forall a. SomeException -> Result a
Throw SomeException
e)
                  Blocked IVar b
ib Cont r
wfB' ->
                    Result t -> InstanceM (Result t)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return
                      ( IVar b -> Cont t -> Result t
forall a b. IVar b -> Cont a -> Result a
Blocked
                          IVar b
ib
                          (Cont r
wfB' Cont r -> (r -> Workflow t) -> Cont t
forall a b. Cont b -> (b -> Workflow a) -> Cont a
:>>= \r
b' -> b -> r -> Workflow t
goRight b
b r
b')
                      )
          Throw SomeException
e -> Result t -> InstanceM (Result t)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Result t
forall a. SomeException -> Result a
Throw SomeException
e)
          Blocked IVar b
ia Cont l
wfA' -> do
            rb <- ContinuationEnv -> InstanceM (Result r)
wfB ContinuationEnv
env
            case rb of
              Done r
eb ->
                case r -> Either a c
discrimB r
eb of
                  Left a
a -> Result t -> InstanceM (Result t)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> Result t
forall a. a -> Result a
Done (a -> t
left a
a))
                  Right c
c ->
                    Result t -> InstanceM (Result t)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (IVar b -> Cont t -> Result t
forall a b. IVar b -> Cont a -> Result a
Blocked IVar b
ia (Cont l
wfA' Cont l -> (l -> Workflow t) -> Cont t
forall a b. Cont b -> (b -> Workflow a) -> Cont a
:>>= \l
a' -> l -> c -> Workflow t
goLeft l
a' c
c))
              Throw SomeException
e -> Result t -> InstanceM (Result t)
forall a. a -> InstanceM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Result t
forall a. SomeException -> Result a
Throw SomeException
e)
              Blocked IVar b
ib Cont r
wfB' -> do
                i <- InstanceM (IVar ())
forall (m :: * -> *) a. MonadIO m => m (IVar a)
newIVar
                addJob env (return ()) i ia
                addJob env (return ()) i ib
                return (Blocked i (Cont (go (toWf wfA') (toWf wfB'))))
      -- The code above makes sure that the computation
      -- wakes up whenever either 'ia' or 'ib' is filled.
      -- The ivar 'i' is used as a synchronisation point
      -- for the whole computation, and we make sure that
      -- whenever 'ia' or 'ib' are filled in then 'i' will
      -- also be filled.

      goRight :: b -> r -> Workflow t
goRight b
b r
eb =
        case r -> Either a c
discrimB r
eb of
          Left a
a -> t -> Workflow t
forall a. a -> Workflow a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> t
left a
a)
          Right c
c -> t -> Workflow t
forall a. a -> Workflow a
forall (m :: * -> *) a. Monad m => a -> m a
return ((b, c) -> t
right (b
b, c
c))
      goLeft :: l -> c -> Workflow t
goLeft l
ea c
c =
        case l -> Either a b
discrimA l
ea of
          Left a
a -> t -> Workflow t
forall a. a -> Workflow a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> t
left a
a)
          Right b
b -> t -> Workflow t
forall a. a -> Workflow a
forall (m :: * -> *) a. Monad m => a -> m a
return ((b, c) -> t
right (b
b, c
c))
  in Workflow l -> Workflow r -> Workflow t
go Workflow l
wfL Workflow r
wfR


{- | This function takes two Workflow computations as input, and returns the
output of whichever computation finished first. The evaluation of the remaining
computation is discontinued.

Note: This function doesn't have a way to explicitly signal to the
incomplete other computation that it will no longer be evaluated,
so you should be careful about ensuring that incomplete
computations are not problematic for your problem domain.
-}
race
  :: RequireCallStack
  => Workflow a
  -> Workflow b
  -> Workflow (Either a b)
race :: forall a b.
RequireCallStack =>
Workflow a -> Workflow b -> Workflow (Either a b)
race = (a -> Either (Either a b) ())
-> (b -> Either (Either a b) ())
-> (Either a b -> Either a b)
-> (((), ()) -> Either a b)
-> Workflow a
-> Workflow b
-> Workflow (Either a b)
forall l a b r c t.
RequireCallStack =>
(l -> Either a b)
-> (r -> Either a c)
-> (a -> t)
-> ((b, c) -> t)
-> Workflow l
-> Workflow r
-> Workflow t
biselectOpt a -> Either (Either a b) ()
forall a b. a -> Either (Either a b) ()
discrimX b -> Either (Either a b) ()
forall b a. b -> Either (Either a b) ()
discrimY Either a b -> Either a b
forall a. a -> a
id ((), ()) -> Either a b
forall {p} {a}. p -> a
right
  where
    discrimX :: a -> Either (Either a b) ()
    discrimX :: forall a b. a -> Either (Either a b) ()
discrimX a
a = Either a b -> Either (Either a b) ()
forall a b. a -> Either a b
Left (a -> Either a b
forall a b. a -> Either a b
Left a
a)

    discrimY :: b -> Either (Either a b) ()
    discrimY :: forall b a. b -> Either (Either a b) ()
discrimY b
b = Either a b -> Either (Either a b) ()
forall a b. a -> Either a b
Left (b -> Either a b
forall a b. b -> Either a b
Right b
b)

    right :: p -> a
right p
_ = String -> a
forall a. HasCallStack => String -> a
error String
"race: We should never have a 'Right ()'"


{- | Run two Workflow actions concurrently, and return the first to finish.

Unlike 'Control.Concurrent.Async.race, this function doesn't explicitly cancel
the other computation. If you want to cancel the other computation,
you should return sufficient context to do so manually
-}
race_ :: RequireCallStack => Workflow a -> Workflow b -> Workflow ()
race_ :: forall a b.
RequireCallStack =>
Workflow a -> Workflow b -> Workflow ()
race_ Workflow a
l Workflow b
r = Workflow (Either a b) -> Workflow ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Workflow (Either a b) -> Workflow ())
-> Workflow (Either a b) -> Workflow ()
forall a b. (a -> b) -> a -> b
$ Workflow a -> Workflow b -> Workflow (Either a b)
forall a b.
RequireCallStack =>
Workflow a -> Workflow b -> Workflow (Either a b)
Temporal.Workflow.race Workflow a
l Workflow b
r


{- | Run two Workflow actions concurrently, and return both results. If either action throws an exception at any time, the other action will run to completion
as long as the exception is caught and handled.
-}
concurrently :: Workflow a -> Workflow b -> Workflow (a, b)
concurrently :: forall a b. Workflow a -> Workflow b -> Workflow (a, b)
concurrently Workflow a
l Workflow b
r = ConcurrentWorkflow (a, b) -> Workflow (a, b)
forall a. ConcurrentWorkflow a -> Workflow a
runConcurrentWorkflowActions ((,) (a -> b -> (a, b))
-> ConcurrentWorkflow a -> ConcurrentWorkflow (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workflow a -> ConcurrentWorkflow a
forall a. Workflow a -> ConcurrentWorkflow a
ConcurrentWorkflow Workflow a
l ConcurrentWorkflow (b -> (a, b))
-> ConcurrentWorkflow b -> ConcurrentWorkflow (a, b)
forall a b.
ConcurrentWorkflow (a -> b)
-> ConcurrentWorkflow a -> ConcurrentWorkflow b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Workflow b -> ConcurrentWorkflow b
forall a. Workflow a -> ConcurrentWorkflow a
ConcurrentWorkflow Workflow b
r)


-- | Like 'concurrently', but ignore the result values.
concurrently_ :: Workflow a -> Workflow b -> Workflow ()
concurrently_ :: forall a b. Workflow a -> Workflow b -> Workflow ()
concurrently_ Workflow a
l Workflow b
r = Workflow (a, b) -> Workflow ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Workflow (a, b) -> Workflow ()) -> Workflow (a, b) -> Workflow ()
forall a b. (a -> b) -> a -> b
$ Workflow a -> Workflow b -> Workflow (a, b)
forall a b. Workflow a -> Workflow b -> Workflow (a, b)
Temporal.Workflow.concurrently Workflow a
l Workflow b
r


{- | Map an effect-performing function over over any 'Traversable' data type, performing each action concurrently,
returning the original data structure with the arguments replaced with the results.

This is actually a bit of a misnomer, since it's really 'traverseConcurrently', but this is copied to mimic the 'async' package's naming
to slightly ease adoption.
-}
mapConcurrently :: Traversable t => (a -> Workflow b) -> t a -> Workflow (t b)
mapConcurrently :: forall (t :: * -> *) a b.
Traversable t =>
(a -> Workflow b) -> t a -> Workflow (t b)
mapConcurrently = (a -> Workflow b) -> t a -> Workflow (t b)
forall (t :: * -> *) a b.
Traversable t =>
(a -> Workflow b) -> t a -> Workflow (t b)
traverseConcurrently


-- | Alias for 'traverseConcurrently_'
mapConcurrently_ :: Foldable t => (a -> Workflow b) -> t a -> Workflow ()
mapConcurrently_ :: forall (t :: * -> *) a b.
Foldable t =>
(a -> Workflow b) -> t a -> Workflow ()
mapConcurrently_ = (a -> Workflow b) -> t a -> Workflow ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> Workflow b) -> t a -> Workflow ()
traverseConcurrently_


-- | Perform the action in the given number of evaluation branches.
replicateConcurrently :: Int -> Workflow a -> Workflow [a]
replicateConcurrently :: forall a. Int -> Workflow a -> Workflow [a]
replicateConcurrently Int
n = ConcurrentWorkflow [a] -> Workflow [a]
forall a. ConcurrentWorkflow a -> Workflow a
runConcurrentWorkflowActions (ConcurrentWorkflow [a] -> Workflow [a])
-> (Workflow a -> ConcurrentWorkflow [a])
-> Workflow a
-> Workflow [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ConcurrentWorkflow a] -> ConcurrentWorkflow [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([ConcurrentWorkflow a] -> ConcurrentWorkflow [a])
-> (Workflow a -> [ConcurrentWorkflow a])
-> Workflow a
-> ConcurrentWorkflow [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ConcurrentWorkflow a -> [ConcurrentWorkflow a]
forall a. Int -> a -> [a]
replicate Int
n (ConcurrentWorkflow a -> [ConcurrentWorkflow a])
-> (Workflow a -> ConcurrentWorkflow a)
-> Workflow a
-> [ConcurrentWorkflow a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workflow a -> ConcurrentWorkflow a
forall a. Workflow a -> ConcurrentWorkflow a
ConcurrentWorkflow


-- | Perform the action in the given number of evaluation branches, discarding the results
replicateConcurrently_ :: Int -> Workflow a -> Workflow ()
replicateConcurrently_ :: forall a. Int -> Workflow a -> Workflow ()
replicateConcurrently_ Int
n = ConcurrentWorkflow () -> Workflow ()
forall a. ConcurrentWorkflow a -> Workflow a
runConcurrentWorkflowActions (ConcurrentWorkflow () -> Workflow ())
-> (Workflow a -> ConcurrentWorkflow ())
-> Workflow a
-> Workflow ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ConcurrentWorkflow ()] -> ConcurrentWorkflow ()
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([ConcurrentWorkflow ()] -> ConcurrentWorkflow ())
-> (Workflow a -> [ConcurrentWorkflow ()])
-> Workflow a
-> ConcurrentWorkflow ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ConcurrentWorkflow () -> [ConcurrentWorkflow ()]
forall a. Int -> a -> [a]
replicate Int
n (ConcurrentWorkflow () -> [ConcurrentWorkflow ()])
-> (Workflow a -> ConcurrentWorkflow ())
-> Workflow a
-> [ConcurrentWorkflow ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workflow () -> ConcurrentWorkflow ()
forall a. Workflow a -> ConcurrentWorkflow a
ConcurrentWorkflow (Workflow () -> ConcurrentWorkflow ())
-> (Workflow a -> Workflow ())
-> Workflow a
-> ConcurrentWorkflow ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workflow a -> Workflow ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void


-- | Evaluate the action in the given number of evaluation branches, accumulating the results
traverseConcurrently :: Traversable t => (a -> Workflow b) -> t a -> Workflow (t b)
traverseConcurrently :: forall (t :: * -> *) a b.
Traversable t =>
(a -> Workflow b) -> t a -> Workflow (t b)
traverseConcurrently a -> Workflow b
f t a
xs = ConcurrentWorkflow (t b) -> Workflow (t b)
forall a. ConcurrentWorkflow a -> Workflow a
runConcurrentWorkflowActions (ConcurrentWorkflow (t b) -> Workflow (t b))
-> ConcurrentWorkflow (t b) -> Workflow (t b)
forall a b. (a -> b) -> a -> b
$ (a -> ConcurrentWorkflow b) -> t a -> ConcurrentWorkflow (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse (Workflow b -> ConcurrentWorkflow b
forall a. Workflow a -> ConcurrentWorkflow a
ConcurrentWorkflow (Workflow b -> ConcurrentWorkflow b)
-> (a -> Workflow b) -> a -> ConcurrentWorkflow b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Workflow b
f) t a
xs


traverseConcurrently_ :: Foldable t => (a -> Workflow b) -> t a -> Workflow ()
traverseConcurrently_ :: forall (t :: * -> *) a b.
Foldable t =>
(a -> Workflow b) -> t a -> Workflow ()
traverseConcurrently_ a -> Workflow b
f t a
xs = ConcurrentWorkflow () -> Workflow ()
forall a. ConcurrentWorkflow a -> Workflow a
runConcurrentWorkflowActions (ConcurrentWorkflow () -> Workflow ())
-> ConcurrentWorkflow () -> Workflow ()
forall a b. (a -> b) -> a -> b
$ (a -> ConcurrentWorkflow b) -> t a -> ConcurrentWorkflow ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Workflow b -> ConcurrentWorkflow b
forall a. Workflow a -> ConcurrentWorkflow a
ConcurrentWorkflow (Workflow b -> ConcurrentWorkflow b)
-> (a -> Workflow b) -> a -> ConcurrentWorkflow b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Workflow b
f) t a
xs


-- | Evaluate each Workflow action in the structure concurrently, and collect the results.
sequenceConcurrently :: Traversable t => t (Workflow a) -> Workflow (t a)
sequenceConcurrently :: forall (t :: * -> *) a.
Traversable t =>
t (Workflow a) -> Workflow (t a)
sequenceConcurrently = ConcurrentWorkflow (t a) -> Workflow (t a)
forall a. ConcurrentWorkflow a -> Workflow a
runConcurrentWorkflowActions (ConcurrentWorkflow (t a) -> Workflow (t a))
-> (t (Workflow a) -> ConcurrentWorkflow (t a))
-> t (Workflow a)
-> Workflow (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Workflow a -> ConcurrentWorkflow a)
-> t (Workflow a) -> ConcurrentWorkflow (t a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse Workflow a -> ConcurrentWorkflow a
forall a. Workflow a -> ConcurrentWorkflow a
ConcurrentWorkflow


-- | Evaluate each Workflow action in the structure concurrently, and ignore the results.
sequenceConcurrently_ :: Foldable t => t (Workflow a) -> Workflow ()
sequenceConcurrently_ :: forall (t :: * -> *) a. Foldable t => t (Workflow a) -> Workflow ()
sequenceConcurrently_ = ConcurrentWorkflow () -> Workflow ()
forall a. ConcurrentWorkflow a -> Workflow a
runConcurrentWorkflowActions (ConcurrentWorkflow () -> Workflow ())
-> (t (Workflow a) -> ConcurrentWorkflow ())
-> t (Workflow a)
-> Workflow ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Workflow a -> ConcurrentWorkflow a)
-> t (Workflow a) -> ConcurrentWorkflow ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Workflow a -> ConcurrentWorkflow a
forall a. Workflow a -> ConcurrentWorkflow a
ConcurrentWorkflow


-- | 'traverseConcurrently' with the arguments flipped.
forConcurrently :: Traversable t => t a -> (a -> Workflow b) -> Workflow (t b)
forConcurrently :: forall (t :: * -> *) a b.
Traversable t =>
t a -> (a -> Workflow b) -> Workflow (t b)
forConcurrently = ((a -> Workflow b) -> t a -> Workflow (t b))
-> t a -> (a -> Workflow b) -> Workflow (t b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Workflow b) -> t a -> Workflow (t b)
forall (t :: * -> *) a b.
Traversable t =>
(a -> Workflow b) -> t a -> Workflow (t b)
traverseConcurrently


-- | 'traverseConcurrently_' with the arguments flipped.
forConcurrently_ :: Foldable t => t a -> (a -> Workflow b) -> Workflow ()
forConcurrently_ :: forall (t :: * -> *) a b.
Foldable t =>
t a -> (a -> Workflow b) -> Workflow ()
forConcurrently_ = ((a -> Workflow b) -> t a -> Workflow ())
-> t a -> (a -> Workflow b) -> Workflow ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Workflow b) -> t a -> Workflow ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> Workflow b) -> t a -> Workflow ()
traverseConcurrently_


{- Similar to 'concurrently', but don't let the failure of one computation affect the other. -}
independently :: Workflow a -> Workflow b -> Workflow (a, b)
independently :: forall a b. Workflow a -> Workflow b -> Workflow (a, b)
independently Workflow a
l Workflow b
r = do
  (el, er) <- Workflow (Either SomeException a)
-> Workflow (Either SomeException b)
-> Workflow (Either SomeException a, Either SomeException b)
forall a b. Workflow a -> Workflow b -> Workflow (a, b)
Temporal.Workflow.concurrently (Workflow a -> Workflow (Either SomeException a)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
Control.Monad.Catch.try Workflow a
l) (Workflow b -> Workflow (Either SomeException b)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
Control.Monad.Catch.try Workflow b
r)
  let results = (,) (a -> b -> (a, b))
-> Either SomeException a -> Either SomeException (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException a
el Either SomeException (b -> (a, b))
-> Either SomeException b -> Either SomeException (a, b)
forall a b.
Either SomeException (a -> b)
-> Either SomeException a -> Either SomeException b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either SomeException b
er
  case results of
    Left SomeException
e -> SomeException -> Workflow (a, b)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwWithCallStack (SomeException
e :: SomeException)
    Right (a, b)
ok -> (a, b) -> Workflow (a, b)
forall a. a -> Workflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a, b)
ok


{-
=== state vars ===

Since state vars await cause Conditions to await, we need a way to track whether they have
been updated since the condition suspended. We give each statevar a unique identifier for
lookups, and a sequence number that updates for each write to the IORef.
-}

{- | 'Workflow's may be sent a cancellation request from the Temporal Platform,
but Workflow code is not required to respond to the cancellation request.

In order to opt in to cancellation handling, you can call 'isCancelRequested'
periodically within your workflow code to check whether a cancellation request
has been received.
-}
isCancelRequested :: RequireCallStack => Workflow Bool
isCancelRequested :: RequireCallStack => Workflow Bool
isCancelRequested = do
  Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
  inst <- Workflow WorkflowInstance
askInstance
  res <- tryReadIVar inst.workflowCancellationVar
  case res of
    Maybe ()
Nothing -> Bool -> Workflow Bool
forall a. a -> Workflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    Just () -> Bool -> Workflow Bool
forall a. a -> Workflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True


{- | Block the current workflow's main execution thread until the workflow is cancelled.

The workflow can still respond to signals and queries while waiting for cancellation.

Upon cancellation, the workflow will throw a 'WorkflowCancelRequested' exception.

This function is useful for actor-style workflows that perform work in response to signals
and/or respond to queries, but otherwise need to remain idle on their main codepath.

N.B. It is likely not safe to call this in a signal handler.
-}
waitCancellation :: RequireCallStack => Workflow ()
waitCancellation :: RequireCallStack => Workflow ()
waitCancellation = do
  Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
  inst <- Workflow WorkflowInstance
askInstance
  getIVar inst.workflowCancellationVar
  throw WorkflowCancelRequested


defaultRetryPolicy :: RetryPolicy
defaultRetryPolicy :: RetryPolicy
defaultRetryPolicy =
  RetryPolicy
    { initialInterval :: Duration
initialInterval = Int64 -> Duration
seconds Int64
1
    , backoffCoefficient :: Double
backoffCoefficient = Double
2
    , maximumInterval :: Maybe Duration
maximumInterval = Maybe Duration
forall a. Maybe a
Nothing
    , maximumAttempts :: Int32
maximumAttempts = Int32
0
    , nonRetryableErrorTypes :: Vector Text
nonRetryableErrorTypes = Vector Text
forall a. Monoid a => a
mempty
    }


{- | A value of type 'ConcurrentWorkflow' a is a 'Workflow' operation that can be composed with other ConcurrentWorkflow values, using the Applicative and Alternative instances.

'ConcurrentWorkflow' effectively operates as a computation DAG. It's evaluated by exploring the expression across all of the branches of computation until every branch becomes blocked
waiting on results from Temporal.

Once that happens, it submits all commands that it has accumulated to the Temporal orchestrator and waits to be reactivated with commands from the orchestrator that unblock
computation on one or more branches. This is repeated until the computation completes. When 'Applicative' is used, that means that each computation branch doesn't depend on the
result of the others, so they can all explore as far as possible and get blocked. If we use 'Monad', then that means that the result of the previous computation has to become
unblocked in order to provide the result to the subsequent computation.
-}
newtype ConcurrentWorkflow a = ConcurrentWorkflow {forall a. ConcurrentWorkflow a -> Workflow a
runConcurrentWorkflowActions :: Workflow a}
  deriving newtype ((forall a b.
 (a -> b) -> ConcurrentWorkflow a -> ConcurrentWorkflow b)
-> (forall a b. a -> ConcurrentWorkflow b -> ConcurrentWorkflow a)
-> Functor ConcurrentWorkflow
forall a b. a -> ConcurrentWorkflow b -> ConcurrentWorkflow a
forall a b.
(a -> b) -> ConcurrentWorkflow a -> ConcurrentWorkflow b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> ConcurrentWorkflow a -> ConcurrentWorkflow b
fmap :: forall a b.
(a -> b) -> ConcurrentWorkflow a -> ConcurrentWorkflow b
$c<$ :: forall a b. a -> ConcurrentWorkflow b -> ConcurrentWorkflow a
<$ :: forall a b. a -> ConcurrentWorkflow b -> ConcurrentWorkflow a
Functor, Monad ConcurrentWorkflow
Monad ConcurrentWorkflow =>
(forall msg.
 ToLogStr msg =>
 Loc -> Text -> LogLevel -> msg -> ConcurrentWorkflow ())
-> MonadLogger ConcurrentWorkflow
forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> ConcurrentWorkflow ()
forall (m :: * -> *).
Monad m =>
(forall msg.
 ToLogStr msg =>
 Loc -> Text -> LogLevel -> msg -> m ())
-> MonadLogger m
$cmonadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> ConcurrentWorkflow ()
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> ConcurrentWorkflow ()
MonadLogger, NonEmpty (ConcurrentWorkflow a) -> ConcurrentWorkflow a
ConcurrentWorkflow a
-> ConcurrentWorkflow a -> ConcurrentWorkflow a
(ConcurrentWorkflow a
 -> ConcurrentWorkflow a -> ConcurrentWorkflow a)
-> (NonEmpty (ConcurrentWorkflow a) -> ConcurrentWorkflow a)
-> (forall b.
    Integral b =>
    b -> ConcurrentWorkflow a -> ConcurrentWorkflow a)
-> Semigroup (ConcurrentWorkflow a)
forall b.
Integral b =>
b -> ConcurrentWorkflow a -> ConcurrentWorkflow a
forall a.
Semigroup a =>
NonEmpty (ConcurrentWorkflow a) -> ConcurrentWorkflow a
forall a.
Semigroup a =>
ConcurrentWorkflow a
-> ConcurrentWorkflow a -> ConcurrentWorkflow a
forall a b.
(Semigroup a, Integral b) =>
b -> ConcurrentWorkflow a -> ConcurrentWorkflow a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: forall a.
Semigroup a =>
ConcurrentWorkflow a
-> ConcurrentWorkflow a -> ConcurrentWorkflow a
<> :: ConcurrentWorkflow a
-> ConcurrentWorkflow a -> ConcurrentWorkflow a
$csconcat :: forall a.
Semigroup a =>
NonEmpty (ConcurrentWorkflow a) -> ConcurrentWorkflow a
sconcat :: NonEmpty (ConcurrentWorkflow a) -> ConcurrentWorkflow a
$cstimes :: forall a b.
(Semigroup a, Integral b) =>
b -> ConcurrentWorkflow a -> ConcurrentWorkflow a
stimes :: forall b.
Integral b =>
b -> ConcurrentWorkflow a -> ConcurrentWorkflow a
Semigroup, Semigroup (ConcurrentWorkflow a)
ConcurrentWorkflow a
Semigroup (ConcurrentWorkflow a) =>
ConcurrentWorkflow a
-> (ConcurrentWorkflow a
    -> ConcurrentWorkflow a -> ConcurrentWorkflow a)
-> ([ConcurrentWorkflow a] -> ConcurrentWorkflow a)
-> Monoid (ConcurrentWorkflow a)
[ConcurrentWorkflow a] -> ConcurrentWorkflow a
ConcurrentWorkflow a
-> ConcurrentWorkflow a -> ConcurrentWorkflow a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (ConcurrentWorkflow a)
forall a. Monoid a => ConcurrentWorkflow a
forall a.
Monoid a =>
[ConcurrentWorkflow a] -> ConcurrentWorkflow a
forall a.
Monoid a =>
ConcurrentWorkflow a
-> ConcurrentWorkflow a -> ConcurrentWorkflow a
$cmempty :: forall a. Monoid a => ConcurrentWorkflow a
mempty :: ConcurrentWorkflow a
$cmappend :: forall a.
Monoid a =>
ConcurrentWorkflow a
-> ConcurrentWorkflow a -> ConcurrentWorkflow a
mappend :: ConcurrentWorkflow a
-> ConcurrentWorkflow a -> ConcurrentWorkflow a
$cmconcat :: forall a.
Monoid a =>
[ConcurrentWorkflow a] -> ConcurrentWorkflow a
mconcat :: [ConcurrentWorkflow a] -> ConcurrentWorkflow a
Monoid, Applicative ConcurrentWorkflow
Applicative ConcurrentWorkflow =>
(forall a. ConcurrentWorkflow a)
-> (forall a.
    ConcurrentWorkflow a
    -> ConcurrentWorkflow a -> ConcurrentWorkflow a)
-> (forall a. ConcurrentWorkflow a -> ConcurrentWorkflow [a])
-> (forall a. ConcurrentWorkflow a -> ConcurrentWorkflow [a])
-> Alternative ConcurrentWorkflow
forall a. ConcurrentWorkflow a
forall a. ConcurrentWorkflow a -> ConcurrentWorkflow [a]
forall a.
ConcurrentWorkflow a
-> ConcurrentWorkflow a -> ConcurrentWorkflow a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
$cempty :: forall a. ConcurrentWorkflow a
empty :: forall a. ConcurrentWorkflow a
$c<|> :: forall a.
ConcurrentWorkflow a
-> ConcurrentWorkflow a -> ConcurrentWorkflow a
<|> :: forall a.
ConcurrentWorkflow a
-> ConcurrentWorkflow a -> ConcurrentWorkflow a
$csome :: forall a. ConcurrentWorkflow a -> ConcurrentWorkflow [a]
some :: forall a. ConcurrentWorkflow a -> ConcurrentWorkflow [a]
$cmany :: forall a. ConcurrentWorkflow a -> ConcurrentWorkflow [a]
many :: forall a. ConcurrentWorkflow a -> ConcurrentWorkflow [a]
Alternative, MonadThrow ConcurrentWorkflow
MonadThrow ConcurrentWorkflow =>
(forall e a.
 (HasCallStack, Exception e) =>
 ConcurrentWorkflow a
 -> (e -> ConcurrentWorkflow a) -> ConcurrentWorkflow a)
-> MonadCatch ConcurrentWorkflow
forall e a.
(HasCallStack, Exception e) =>
ConcurrentWorkflow a
-> (e -> ConcurrentWorkflow a) -> ConcurrentWorkflow a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
ConcurrentWorkflow a
-> (e -> ConcurrentWorkflow a) -> ConcurrentWorkflow a
catch :: forall e a.
(HasCallStack, Exception e) =>
ConcurrentWorkflow a
-> (e -> ConcurrentWorkflow a) -> ConcurrentWorkflow a
MonadCatch, Monad ConcurrentWorkflow
Monad ConcurrentWorkflow =>
(forall e a.
 (HasCallStack, Exception e) =>
 e -> ConcurrentWorkflow a)
-> MonadThrow ConcurrentWorkflow
forall e a.
(HasCallStack, Exception e) =>
e -> ConcurrentWorkflow a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a.
(HasCallStack, Exception e) =>
e -> ConcurrentWorkflow a
throwM :: forall e a.
(HasCallStack, Exception e) =>
e -> ConcurrentWorkflow a
MonadThrow)


instance Applicative ConcurrentWorkflow where
  pure :: forall a. a -> ConcurrentWorkflow a
pure = Workflow a -> ConcurrentWorkflow a
forall a. Workflow a -> ConcurrentWorkflow a
ConcurrentWorkflow (Workflow a -> ConcurrentWorkflow a)
-> (a -> Workflow a) -> a -> ConcurrentWorkflow a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Workflow a
forall a. a -> Workflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ConcurrentWorkflow Workflow (a -> b)
f <*> :: forall a b.
ConcurrentWorkflow (a -> b)
-> ConcurrentWorkflow a -> ConcurrentWorkflow b
<*> ConcurrentWorkflow Workflow a
a = Workflow b -> ConcurrentWorkflow b
forall a. Workflow a -> ConcurrentWorkflow a
ConcurrentWorkflow (Workflow (a -> b) -> Workflow a -> Workflow b
forall a b. Workflow (a -> b) -> Workflow a -> Workflow b
parallelAp Workflow (a -> b)
f Workflow a
a)


instance Monad ConcurrentWorkflow where
  ConcurrentWorkflow Workflow a
m >>= :: forall a b.
ConcurrentWorkflow a
-> (a -> ConcurrentWorkflow b) -> ConcurrentWorkflow b
>>= a -> ConcurrentWorkflow b
f = Workflow b -> ConcurrentWorkflow b
forall a. Workflow a -> ConcurrentWorkflow a
ConcurrentWorkflow (Workflow b -> ConcurrentWorkflow b)
-> Workflow b -> ConcurrentWorkflow b
forall a b. (a -> b) -> a -> b
$ do
    x <- Workflow a
m
    let ConcurrentWorkflow m' = f x
    m'